Excel 2016 VBA Dateiliste aus Excel in Laufwerk Verzeichnisse vergleichen und Hyperlinks generieren bei gefunden und kopieren

Sub SucheVergleich()

Dim sourceFolder As String
sourceFolder = "C:\temp\Testverzeichnis\Source"

'Call ClearImmediateWindow

'fListFilesTest sourceFolder, True, , "*"
fListFilesTest sourceFolder, True

End Sub
Sub ClearImmediateWindow()
Application.VBE.Windows("Direktbereich").Visible = True
Application.VBE.Windows("Direktbereich").SetFocus
SendKeys "^{HOME}+^{END}{DEL}", False
End Sub

Sub fListFilesTest(Optional ByVal sPath As String, _
Optional ByVal bSubfolders As Boolean = False, _
Optional ByVal sFilenameFilter As String = "*", _
Optional ByVal sExtensionFilter As String = "*")

'Sub fListFilesTest(ByVal sPath As String, _
' Optional ByVal bSubfolders As Boolean = False, _
' Optional ByVal sFilenameFilter As String = "*", _
' Optional ByVal sExtensionFilter As String = "*")

'sPath = "C:\temp\Testverzeichnis\Source"

Dim oFS As Object
Dim oFolder As Object
Dim oSubfolder As Object
Dim oFile As Object

Dim targetFolder As String
targetFolder = "C:\temp\Testverzeichnis\Target\"

Set oFS = CreateObject("Scripting.FileSystemObject")
Set oFolder = oFS.GetFolder(sPath)
For Each oFile In oFolder.Files

If oFile.Name Like sFilenameFilter & "." & sExtensionFilter Then

Debug.Print "-----------------"
Debug.Print "Datei in LW gefunden"

' ' Dateiendung
' Debug.Print oFS.GetExtensionName(oFile)

' ' Dateiname
' Debug.Print oFS.GetBaseName(oFile)

' ' Laufwerksname
' Debug.Print oFS.GetDriveName(oFile)

' gesamter Pfad
Debug.Print oFile.Path

' ' Pfad
' Debug.Print oFile.ParentFolder

' Dateiname + Endung
Debug.Print oFile.Name
Debug.Print "-----------------"

End If

Call Vergleich(oFile.Name, oFile.Path, targetFolder)

Next

If bSubfolders Then
For Each oSubfolder In oFolder.SubFolders
'Call Vergleich("test", oFolder.SubFolders, targetFolder)
fListFiles oSubfolder
Next
End If

Set oFile = Nothing
Set oSubfolder = Nothing
Set oFolder = Nothing
Set oFS = Nothing
End Sub

Sub Vergleich(fileName As String, filePath As String, Optional targetFolder As String)

Dim oFS As Object
Set oFS = CreateObject("Scripting.FileSystemObject")

i = 1
iT = 1

BisEndeSpalteA = (ThisWorkbook.Sheets("Dateiliste").Cells(1048576, 1).End(xlUp).Row - 6)
For iT = 1 To BisEndeSpalteA

Debug.Print "Vergleiche S: " & fileName
Debug.Print "Vergleiche T: " & ThisWorkbook.Sheets("Dateiliste").Range("A6").Offset(iT, 0).Value

If ThisWorkbook.Sheets("Dateiliste").Range("A6").Offset(i, 0).Value = fileName Then

'gefundene Dateinamen ab B6 einfügen
ThisWorkbook.Sheets("Dateiliste").Range("B6").Offset(i, 0) = fileName

'gefundenes Verzeichnis ab C6 einfügen
ThisWorkbook.Sheets("Dateiliste").Range("C6").Offset(i, 0) = filePath

'Hyperlink der gefundenen Datei und Verzeichnis ab D6 erstellen
With Worksheets("Dateiliste")
.Hyperlinks.Add Anchor:=.Range("D6").Offset(i, 0), _
Address:=filePath, _
ScreenTip:="Teste URL", _
TextToDisplay:=fileName
End With

'Alternativ verschieben
'oFS.movefile oFile.Path, targetFolder & oFile.Name
'Alternativ kopieren
oFS.copyfile filePath, targetFolder & fileName, True

Debug.Print "---------------------------------------"
Debug.Print "Kopiert nach: " & targetFolder & fileName
Debug.Print "---------------------------------------"

'MsgBox "Gefunden: " & targetFolder & fileName

'TARGET - kopiertes Verzeichnis ab E6 einfügen
ThisWorkbook.Sheets("Dateiliste").Range("E6").Offset(i, 0) = targetFolder

'TARGET - Hyperlink der kopierten Datei und Verzeichnis ab F6 erstellen
With Worksheets("Dateiliste")
.Hyperlinks.Add Anchor:=.Range("F6").Offset(i, 0), _
Address:=targetFolder, _
ScreenTip:="Teste URL", _
TextToDisplay:=fileName
End With

End If
i = i + 1
Next iT
End Sub