VBA-Code für Durchsuchen in allen Unterverzeichnissen (VBA)

Joachim, Samstag, 12.01.2019, 16:49 (vor 132 Tagen)

Hallo zusammen,

kann mir jemand helfen, dass beim Code unten die Suche auch auf alle untergeordneten
Verzeichnisse ausgedehnt wird - oldPath...

Falls das nicht zu umfangreich ist, evtl. noch ein Zielordner "NOT FOUND" wo die nicht
gefundenen Dateien abgelegt werden.

Ich danke Euch....Jo

Sub Dateien_kopieren()
On Error GoTo Fehler
Dim TB, L1 As Integer, LR As Double, Z
Dim PfadOld As String, Datei As String
Dim PfadNew As String, Spalte As String, SP As Integer

Set TB = ActiveWorkbook.Sheets("Tabelle1")
L1 = 1 'Start ab Zeile1
PfadOld = "C:\Temp\" ' inkl. \ am Ende

PfadNew = "C:\Temp\Ziel\" ' inkl. \ am Ende
If Dir(PfadNew, vbDirectory) = "" Then MkDir PfadNew ' Wenn Verzeichnis fehlt, erstellen

Spalte = InputBox("Welche Spalte soll abgearbeitet werden?", "Dateien separieren", "C")
SP = TB.Columns(Spalte).Column 'Zahl der Spalte
LR = TB.Cells(TB.Rows.Count, SP).End(xlUp).Row 'letzte Zeile der Spalte

For Each Z In TB.Range(TB.Cells(L1, SP), TB.Cells(LR, SP)) 'Jeder Eintag wird abgearbeitet
If Z <> "" Then
Datei = Dir(PfadOld & Z & "*.*")
Do While Len(Datei) > 0

Select Case Right(Datei, 4)
Case ".pdf", ".dxf", ".step", "xlsx"

FileCopy PfadOld & Datei, PfadNew & Datei

Case Else

'nichts

End Select

Datei = Dir() ' nächste Datei
Loop
End If

Next

Err.Clear
Fehler:
If Err.Number <> 0 Then MsgBox "Fehler: " & _
Err.Number & vbLf & Err.Description: Err.Clear
End Sub


gesamter Thread:

 RSS-Feed dieser Diskussion

powered by my little forum