Ein Ordner mit allen Unterordner + Dateien kopieren

zachaeus

Grünschnabel
Hallo,

ich habe das prob, dass ich einen Ordner mit samt seinen Unterordnern und Dateien kopieren möchte.
Nur komme ich über den eigendlichen Ordner nicht hinaus, d.h. ich kann nicht die Unterordner und deren Unterordner usw. mit dateien kopieren.
Außerdem, und das ist das eigentliche Ziel, will ich alle ordner- und dateiname in kleinbuchstaben verwandeln.

Frohe Weihnachten und einen guten Rutsch, Matthias
 
Wie hast du das kopieren den bis jetzt realisiert? Ich würde das ganze über ShellExecute und dann mit copy bzw. xcopy machen, ist wohl das einfachste.

Greetz...
Sinac
 
Hallo,

nach weiterem such im netz bin ich auf folgenden Code gestoßßen, den ich für meine Zwecke angepasst habe:

Sub aufruf()
quelle = "C:\temp"
ziel = "C:\temp_copy"

DirCopy quelle, ziel
End Sub


' Funktion um alle Dateien eines Ordner zu ermitteln
Private Function ReadFilesFromDir(ByVal sPath As String, _
Optional sFilter As String = "*.*") As Variant

Dim sFilename As String
Dim nCount As Long
ReDim sFiles(0) As String

If Right$(sPath, 1) <> "\" Then sPath = sPath & "\"
nCount = 0
sFilename = Dir(sPath & sFilter, vbNormal)
While sFilename <> ""
If sFilename <> "." And sFilename <> ".." Then
ReDim Preserve sFiles(nCount)
sFiles(nCount) = sFilename
nCount = nCount + 1
End If
sFilename = Dir
Wend

ReadFilesFromDir = sFiles
End Function

' Funktion, um alle Ordner einer Ebene zu ermitteln
Private Function ReadDirs(ByVal sPath As String) As Variant
Dim sFilename As String
Dim nCount As Long
ReDim sFiles(0) As String

If Right$(sPath, 1) <> "\" Then sPath = sPath & "\"
nCount = 0
sFilename = Dir(sPath, vbDirectory)
While sFilename <> ""
If sFilename <> "." And sFilename <> ".." And _
GetAttr(sPath & "\" & sFilename) = vbDirectory Then

ReDim Preserve sFiles(nCount)
sFiles(nCount) = sFilename
nCount = nCount + 1
End If
sFilename = Dir
Wend

ReadDirs = sFiles
End Function


' Ordner inkl. aller Dateien und Unterordner kopieren
Public Function DirCopy(ByVal sDir As String, _
ByVal dDir As String)

Dim dcV As Variant, dcI As Integer

On Error Resume Next

' zunächst alle Dateien ermitteln
If sDir = dDir Then Exit Function
dcV = ReadFilesFromDir(sDir)

' Ziel-Verzeichnis erstellen
MkDir LCase(dDir)

' alle Dateien kopieren
For dcI = 0 To UBound(dcV)
FileCopy sDir & "\" & dcV(dcI), LCase(dDir & "\" & dcV(dcI))
Next dcI

' Jetzt alle Unterordner ermitteln und Dateien kopieren
dcV = ReadDirs(sDir)
For dcI = 0 To UBound(dcV)
' Es kann vorkommen, dass jemand den Ordner in sich
' selbst kopieren will - was eine Endlosschleife gäbe:
If dcV(dcI) = "" Then Exit For

' Ziel-Unterordner erstellen:
MkDir LCase(dDir & "\" & dcV(dcI))

' Rekursiver Funktionsaufruf, um den Unterordner
' zu erstellen und die Dateien zu kopieren
DirCopy sDir & "\" & dcV(dcI), dDir & "\" & dcV(dcI)
Next dcI
End Function
 
Zurück