Private Sub Command1_Click()
fCopy "H:\*.*", "C:\Backup", True 'True überschreibt ohne Nachfrage
End Sub

Private Const FN_COPY = &H2&
Private Const FN_DELETE = &H3&
Private Const FN_MOVE = &H1&
Private Const FN_RENAME = &H4&
Private Const FNF_ALLOWUNDO = &H40&
Private Const FNF_CONFIRMMOUSE = &H2&
Private Const FnF_CREATEPROGRESSDLG = &H0&
Private Const FnF_FILESONLY = &H80&
Private Const FnF_MULTIDESTFILES = &H1&
Private Const FnF_NOCONFIRMATION = &H10&
Private Const FnF_NOCONFIRMMKDIR = &H200&
Private Const FnF_RENAMEONCOLLISION = &H8&
Private Const FnF_SILENT = &H4&
Private Const FnF_SIMPLEPROGRESS = &H100&
Private Const FnF_WANTMAPPINGHANDLE = &H20&
 
Private Declare Function SHFileOperation Lib "shell32.dll" _
  Alias "SHFileOperationA" (lpFileOp As SHFILEOPSTRUCT) _
  As Long
 
Type SHFILEOPSTRUCT
  Hwnd As Long
  wFunc As Long
  pFrom As String
  pTo As String
  fFlags As Integer
  fAnyOperationsAborted As Boolean
  hNameMappings As Long
  lpszProgressTitle As String
End Type
 
Public Function fCopy(Source As String, Dest As String, _
  Ueberschreiben As Boolean) As Long
 
  Dim FileStructur As SHFILEOPSTRUCT
  Dim FLAG As Integer
 
  FLAG = 0
  If InStr(Source, vbNullChar + vbNullChar) > 0 Then _
    FLAG = FLAG + FnF_MULTIDESTFILES
 
  If InStr(Source, "*") > 6 Then _
    FLAG = FLAG + FnF_FILESONLY
 
  With FileStructur
    .Hwnd = Screen.ActiveForm.Hwnd
    .wFunc = FN_COPY
    .pFrom = Check_NullChars(Source)
    .pTo = Dest
    .fFlags = FLAG
  End With
 
  fCopy = SHFileOperation(FileStructur)
 
End Function
 
Public Function fDelete(Source As String, DelToTrash As _
  Boolean, ShowDialog As Boolean) As Long
 
  Dim FileStructur As SHFILEOPSTRUCT
  Dim Flags As Long
 
  Flags = 0
  If DelToTrash Then Flags = FNF_ALLOWUNDO
  If Not ShowDialog Then Flags = Flags Or FnF_NOCONFIRMATION
 
  With FileStructur
    .Hwnd = Screen.ActiveForm.Hwnd
    .wFunc = FN_DELETE
    .pFrom = Check_NullChars(Source)
    .fFlags = Flags
  End With
 
  fDelete = SHFileOperation(FileStructur)
End Function
 
Public Function fMove(Source As String, _
  Dest As String) As Long
 
  Dim FileStructur As SHFILEOPSTRUCT
 
  With FileStructur
    .Hwnd = Screen.ActiveForm.Hwnd
    .wFunc = FN_RENAME
    .pFrom = Check_NullChars(Source)
    .pTo = Dest
    .fFlags = FnF_RENAMEONCOLLISION + FnF_SILENT
  End With
 
  fMove = SHFileOperation(FileStructur)
End Function
 
Public Function fRename(Source As String, _
  Dest As String) As Long
 
  Dim FileStructur As SHFILEOPSTRUCT
 
  With FileStructur
    .Hwnd = Screen.ActiveForm.Hwnd
    .wFunc = FN_RENAME
    .pFrom = Check_NullChars(Source)
    .pTo = Dest
    .fFlags = FnF_RENAMEONCOLLISION + FnF_SILENT
  End With
 
  fRename = SHFileOperation(FileStructur)
End Function
 
Public Function FilesFromArray(Liste() As String) As String
  Dim i As Long
  Dim temp As String
 
  For i = 0 To UBound(Liste)
    If FileExists(Liste(i)) Then
      temp = temp + Liste(i) + vbNullChar
    Else
      MsgBox (Liste(i) & "existiert hier nicht")
    End If
  Next
 
  FilesFromArray = temp + vbNullChar
End Function
 
Private Function Check_NullChars(S As String) As String
  If Right(S, 2) <> vbNullChar + vbNullChar Then
    If Right(S, 1) <> vbNullChar Then
      S = S + vbNullChar + vbNullChar
    Else
      S = S + vbNullChar
    End If
  End If
  Check_NullChars = S
End Function
 
Public Function FileExist(ByVal Filename As String) _
  As Boolean
 
  FileExists = (Dir(Filename) <> "")
End Function