|
Hallo Olli,
hier der Code:
Public Sub FindFolders()
' ersetzt alle Ordner Daten auf Laufwerk D durch den Ordner C:\Daten
SeekFolders "C:\Daten", "Daten", "D:\"
End Sub
Public Sub SeekFolders(sourcepath As String, fldName, drvPath)
Dim fso, fld, subfld, sourcefld, entry, dest, path, name
Set fso = CreateObject("Scripting.FileSystemObject")
Set sourcefld = fso.GetFolder(sourcepath)
Set fld = fso.GetFolder(drvPath)
Set subfld = fld.SubFolders
For Each entry In subfld
path = entry.path
name = entry.name
If entry.path <> source And entry.name = fldName Then
Set dest = entry.ParentFolder
entry.Delete True
subfld.Add fldName
fso.CopyFolder sourcepath, dest.path & "\" & fldName
End If
If name <> fldName Then _
SeekFolders sourcepath, fldName, path
Next
End Sub
Grüße Lutz
|