Copy, Move, Rename, Delete file(s) with progress bar (1 Viewer)

[arnelgp]

' https://forums.codeguru.com/showthread.php?21901-Displaying-progress-bar-during-copying-files
' modified by arnelgp for x64 use
'
#If VBA7 Then
Private Declare PtrSafe Function SHFileOperation Lib "shell32.dll" Alias "SHFileOperationA" (lpFileOp As SHFILEOPSTRUCT) As Long
#Else
Private Declare Function SHFileOperation Lib "shell32.dll" Alias "SHFileOperationA" (lpFileOp As SHFILEOPSTRUCT) As Long
#End If

Private Type SHFILEOPSTRUCT
    #If VBA7 Then
       hWnd As LongPtr
    #Else
       hWnd As Long
    #End If
       wFunc As Long
       pFrom As String
       pTo As String
       fFlags As Integer
       fAborted As Boolean
    #If VBA7 Then
       hNameMaps As LongPtr
    #Else
       hNameMaps As Long
    #End If
       sProgress As String
End Type

Private Const FO_DELETE = &H3
Private Const FO_COPY = &H2
Private Const FO_MOVE = &H1
Private Const FO_RENAME = &H4
Private Const FOF_ALLOWUNDO = &H40


' ARNELGP
'
' Note, there is no checking of whether the src file exists or not
' you need to implement it prior to calling the apiXXX() functions
'
Public Function apiCopyFile(ByVal src As String, ByVal trg As String) As Boolean
apiCopyFile = apiExecute(src, trg, FO_COPY)
End Function

Public Function apiRenameFile(ByVal src As String, ByVal trg As String) As Boolean
apiRenameFile = apiExecute(src, trg, FO_RENAME)
End Function

Public Function apiMoveFile(ByVal src As String, ByVal trg As String) As Boolean
apiMoveFile = apiExecute(src, trg, FO_MOVE)
End Function

Public Function apiDeleteFile(ByVal src As String) As Boolean
apiDeleteFile = apiExecute(src, "", FO_DELETE)
End Function

Private Function apiExecute(ByVal src As String, ByVal trg As String, ByVal flag As Long) As Boolean
    Dim SHFileOp As SHFILEOPSTRUCT
    With SHFileOp
       .pFrom = src
       .pTo = trg
       .wFunc = flag
    End With
    'perform file operation
    apiExecute = (SHFileOperation(SHFileOp) = 0)
    'MsgBox "The Folder '" + SHFileOp.pFrom + "' has been Copied To : " & SHFileOp.pTo, vbInformation + vbOKOnly, App.Title
End Function

 

[skymou]

' https://forums.codeguru.com/showthread.php?21901-Displaying-progress-bar-during-copying-files
' modified by arnelgp for x64 use
'
#If VBA7 Then
Private Declare PtrSafe Function SHFileOperation Lib "shell32.dll" Alias "SHFileOperationA" (lpFileOp As SHFILEOPSTRUCT) As Long
#Else
Private Declare Function SHFileOperation Lib "shell32.dll" Alias "SHFileOperationA" (lpFileOp As SHFILEOPSTRUCT) As Long
#End If

Private Type SHFILEOPSTRUCT
    #If VBA7 Then
       hWnd As LongPtr
    #Else
       hWnd As Long
    #End If
       wFunc As Long
       pFrom As String
       pTo As String
       fFlags As Integer
       fAborted As Boolean
    #If VBA7 Then
       hNameMaps As LongPtr
    #Else
       hNameMaps As Long
    #End If
       sProgress As String
End Type

Private Const FO_DELETE = &H3
Private Const FO_COPY = &H2
Private Const FO_MOVE = &H1
Private Const FO_RENAME = &H4
Private Const FOF_ALLOWUNDO = &H40


' ARNELGP
'
' Note, there is no checking of whether the src file exists or not
' you need to implement it prior to calling the apiXXX() functions
'
Public Function apiCopyFile(ByVal src As String, ByVal trg As String) As Boolean
apiCopyFile = apiExecute(src, trg, FO_COPY)
End Function

Public Function apiRenameFile(ByVal src As String, ByVal trg As String) As Boolean
apiRenameFile = apiExecute(src, trg, FO_RENAME)
End Function

Public Function apiMoveFile(ByVal src As String, ByVal trg As String) As Boolean
apiMoveFile = apiExecute(src, trg, FO_MOVE)
End Function

Public Function apiDeleteFile(ByVal src As String) As Boolean
apiDeleteFile = apiExecute(src, "", FO_DELETE)
End Function

Private Function apiExecute(ByVal src As String, ByVal trg As String, ByVal flag As Long) As Boolean
    Dim SHFileOp As SHFILEOPSTRUCT
    With SHFileOp
       .pFrom = src
       .pTo = trg
       .wFunc = flag
    End With
    'perform file operation
    apiExecute = (SHFileOperation(SHFileOp) = 0)
    'MsgBox "The Folder '" + SHFileOp.pFrom + "' has been Copied To : " & SHFileOp.pTo, vbInformation + vbOKOnly, App.Title
End Function

In your Type declaration, fAborted should be a Long, not a Boolean. It is declared in the Windows C++ header file as a BOOL, which is a Long integer in C++.

Even though your type structure is misaligned, your functions do work, I believe, simply because you do not use fAborted or any of the subsequent members so VBA defaults them to zero.

Steve