Verzeichnis erstellen

Sie möchten ein nicht existierendes Verzeichnis samt Unterverzeichnissen erstellen?
Wollen sie ein komplettes Verzeichnis samt Unterverzeichnissen und Dateien in ein anderes, auch nicht vorhandenes, kopieren? Oder haben sie vor, ein vorhandenes Verzeichnis samt Unterverzeichnissen und Dateien löschen?
Ein paar API-Funktionen machen das, auch ohne das FileSystemObject.

Option Explicit

Declare Function MakePath Lib "imagehlp.dll" Alias _
"MakeSureDirectoryPathExists" _
(ByVal lpPath As String) As Long

Private Declare Function SHFileOperation _
Lib "shell32.dll" Alias "SHFileOperationA" _
(lpFileOp As Any) As Long

Private Type SHFILEOPSTRUCT
    hwnd As Long
    wFunc As Long
    pFrom As String
    pTo As String
    fFlags As Integer
    fAnyOperationsAborted As Long
    hNameMappings As Long
    lpszProgressTitle As String
End Type

Private Const FO_DELETE = &H3
Private Const FO_MOVE = &H1
Private Const FO_RENAME = &H4
Private Const FO_COPY = &H2&
Private Const FOF_RENAMEONCOLLISION = &H8
Private Const FOF_NOCONFIRMMKDIR = &H200
Private Const FOF_NOCONFIRMATION = &H10
Private Const FOF_MULTIDESTFILES = &H1
Private Const FOF_ALLOWUNDO = &H40

Sub TestPfadErstellen()
  PfadErstellen "c:\Test\Test\Test"
End Sub

Public Function PfadErstellen(Pfad As String) As Boolean
Dim a As Long
  If Right$(Pfad, 1) <> "\" Then
    Pfad = Pfad & "\"
  End If
  If MakePath(Pfad) <> 0 Then PfadErstellen = True
End Function

Sub TestXXL_Kopie()
Dim FF As Long
Dim Pfad As String
  Pfad = "c:\Test\Test\Test"
  FF = FreeFile
  PfadErstellen Pfad
  Open Pfad & "\DATEI1" For Binary As FF: Close FF
  Open Pfad & "\DATEI2" For Binary As FF: Close FF
  XXL_Copy Pfad & "\*", Pfad & "\Kopie\"
End Sub

Public Function XXL_Copy(ByVal QuellVerzeichnis As String, _
ByVal Zielverzeichnis As String) As Boolean
Dim udtXCopy As SHFILEOPSTRUCT
  QuellVerzeichnis = QuellVerzeichnis & _
  vbNullChar & vbNullChar
  Zielverzeichnis = Zielverzeichnis & _
  vbNullChar & vbNullChar
  With udtXCopy
    .wFunc = FO_COPY
    .pFrom = QuellVerzeichnis
    .pTo = Zielverzeichnis
    .fFlags = FOF_MULTIDESTFILES _
    Or FOF_NOCONFIRMATION _
    Or FOF_NOCONFIRMMKDIR _
    Or FOF_ALLOWUNDO
  End With
  If SHFileOperation(udtXCopy) = 0 _
  Then XXL_Copy = True
End Function 

Sub TestVerzeichnisLöschen()
  VerzeichnisLöschen "c:\Test"
End Sub

Function VerzeichnisLöschen(Verzeichnis As String) As Boolean
Dim QuellVerzeichnis As String, Zielverzeichnis As String
Dim Pfad As String
Dim udtFileOP As SHFILEOPSTRUCT
  If Dir$(Verzeichnis, vbDirectory) = "" Then Exit Function
  VerzeichnisLöschen = True
  QuellVerzeichnis = Verzeichnis _
  & vbNullChar & vbNullChar
  Zielverzeichnis = vbNullString & _
  vbNullChar & vbNullChar
  With udtFileOP
    .wFunc = FO_DELETE
    .pFrom = Verzeichnis
    .pTo = Zielverzeichnis
    .fFlags = FOF_MULTIDESTFILES _
    Or FOF_NOCONFIRMATION _
    Or FOF_NOCONFIRMMKDIR '_
    'Or FOF_ALLOWUNDO ' In den Papierkorb
  End With
  If SHFileOperation(udtFileOP) <> 0 _
  Then VerzeichnisLöschen = False
End Function