Ich möchte Anhand von Werten einer Excel Datei Bilder aus verschiedenen Ordnern in einen anderen Ordner kopieren. Hierfür habe ich bereits diesen Code entdeckt.
Sub copyfiles()
Dim xRg As Range, xCell As Range
Dim xSFileDlg As FileDialog, xDFileDlg As FileDialog
Dim xSPathStr As Variant, xDPathStr As Variant
Dim xVal As String
On Error Resume Next
Set xRg = Application.InputBox("Please select the file names:", "KuTools For Excel", ActiveWindow.RangeSelection.Address, , , , , 8)
If xRg Is Nothing Then Exit Sub
Set xSFileDlg = Application.FileDialog(msoFileDialogFolderPicker)
xSFileDlg.Title = "Please select the original folder:"
If xSFileDlg.Show <> -1 Then Exit Sub
xSPathStr = xSFileDlg.SelectedItems.Item(1) & "\"
Set xDFileDlg = Application.FileDialog(msoFileDialogFolderPicker)
xDFileDlg.Title = "Please select the destination folder:"
If xDFileDlg.Show <> -1 Then Exit Sub
xDPathStr = xDFileDlg.SelectedItems.Item(1) & "\"
For Each xCell In xRg
xVal = xCell.Value
If TypeName(xVal) = "String" And xVal <> "" Then
FileCopy xSPathStr & xVal, xDPathStr & xVal
End If
Next
End Sub
Nun meine Frage. Wie kann ich erreichen das mit diesem Code auch alle Unterordner durchlaufen werden. Derzeit muss der Pfad exakt angegeben werden in dem sich das Bild befindet. Leider varriert der Pfand ständig. Ein Beispiel:
Pfad 1: Z:\Importe_ab_20180601\bg\bg_20180821\Rohdaten\Bild_Daten\Sammlung\10564\Bilder
Pfad 2: Z:\Importe_ab_20180601\bg\bg_20180821\Rohdaten\Bild_Daten\Sammlung\10566\Bilder
Wie kann ich also erreichen das nicht der gesamte Pfad angegeben werden muss, sondern gleich alle Unterordner ab dem Pfadpunkt "Sammlung" mit durchsucht werden nach den Dateien aus der Excel Liste?
Danke und Gruß