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
If Ueberschreiben = True Then _
FLAG = FLAG + FnF_RENAMEONCOLLISION
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 FileExists(ByVal Filename As String) _
As Boolean
FileExists = (Dir(Filename) <> "")
End Function
