For Each oFolder In fso.GetFolder(txtQuelle.Text).SubFolders
  Ziel = txtZiel.Text
  zOrdner1 = Mid$(oFolder, InStrRev(oFolder1, "\") + 1)
  Result = MakePath(Ziel + "\" + zOrdner1)
  'Alle Dateien aus dem Stammordner kopieren
    For Each oFile In oFolder1.Files
      'FileCounter um 1 hochzählen
      FileCounter = FileCounter + 1
      On Error Resume Next
      'Dateinamen extrahieren
      zDatei = Mid$(oFile, InStrRev(oFile, "\") + 1)
      'Datei kopieren
      fso.CopyFile oFile, Ziel + "\" + zOrdner1 + "\zDatei"
 
        If Err.Number <> 0 Then
            FileCounter = FileCounter - 1
            FileErrorCounter = FileErrorCounter + 1
            FileError = oFile
            oStream.WriteLine FileError
        End If
    Next
Next