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ß