Option Explicit
 
' ===================================================================
' CopyFilesAndFolders (GES)
' Kopieren von Dateien und Ordner, mit der Möglichkeit auszuwählen,
' ob vorhandene Dateien und Ordner überschrieben werden sollen.
'
' Autor:
' Gudio Eisenbeis Software (GES), guidoeisenbeis@web.de, 2003-11-12
' ===================================================================
 
' ! Die Scripting-Komponente SCRRUN.DLL muss als Verweis eingebunden sein!
 
' Falls das Zielverzeichnis nicht existiert, wird es angelegt.
' Zugriffsfehler (z.B. Schreibschutz) werden nicht abgefangen.
' (Kann ja jeder selbst einbauen)
 
' Aufruf-Beispiel:
'   Call CopyFilesAndFolders("C:\QuellOrdner", "D:\ZielOrdner", False)
 
 
Public Sub CopyFilesAndFolders(ByVal SourcePath As String, _
                               ByVal DestPath As String, _
                               ByVal Overwrite As Boolean)
 
  Dim nFSO As FileSystemObject
  Dim ScrFolder As Folder
  Dim SubFolder As Folder
  Dim SubFolderPath As String
  Dim fFile As File
  Dim sFileName As String
 
  Set nFSO = New FileSystemObject
  Set ScrFolder = nFSO.GetFolder(SourcePath)
  With nFSO
    ' Falls das Zielverzeichnis nicht existiert, wird es angelegt.
    If Not .FolderExists(DestPath) Then .CreateFolder (DestPath)
 
    ' Alle Ordner und Unterordner im Zielverzeichnis anlegen,
    ' falls sie nicht existieren.
    DestPath = .BuildPath(DestPath, ScrFolder.Name)
    If Not .FolderExists(DestPath) Then .CreateFolder (DestPath)
    For Each SubFolder In ScrFolder.SubFolders
        SubFolderPath = .GetAbsolutePathName(SubFolder)
        CopyFilesAndFolders SubFolderPath, DestPath, Overwrite
    Next
 
    ' Alle Dateien in das Zielverzeichnis kopieren
    For Each fFile In ScrFolder.Files
        sFileName = .BuildPath(DestPath, fFile.Name)
        If .FileExists(sFileName) Imp Overwrite Then
            .CopyFile fFile, sFileName, Overwrite
        End If
    Next
  End With
End Sub