# Ein Ordner mit allen Unterordner + Dateien kopieren



## zachaeus (23. Dezember 2004)

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


----------



## Sinac (23. Dezember 2004)

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


----------



## zachaeus (23. Dezember 2004)

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


----------



## Sinac (23. Dezember 2004)

Naja, "etwas" mehr Code aber ok


----------

