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

Joachim, Samstag, 12.01.2019, 16:49 (vor 192 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

VBA-Code für Durchsuchen in allen Unterverzeichnissen

Martin Asal @, Sonntag, 13.01.2019, 15:24 (vor 191 Tagen) @ Joachim

Hallo Joachim,

einen speziellen Befehl, der analog zu Dir nach Verzeichnissen sucht, gibt es nicht. Aber ich könnte mir vorstellen, dass so etwas mit dem Scripting.FileSystemObject möglich sein dürfte.

Martin

RSS-Feed dieser Diskussion
powered by my little forum