use the [ CODE ], [ / CODE ] tags to post code
Anyway, here is a working version, i modidfied it a bit.
Hope it helps.Code:Option Explicit Private Const ERROR_SUCCESS As Long = 0& Public Const PROGRESS_CONTINUE As Long = 0 '#define PROGRESS_CONTINUE 0 Public Const PROGRESS_CANCEL As Long = 1 '#define PROGRESS_CANCEL 1 Public Const PROGRESS_STOP As Long = 2 '#define PROGRESS_STOP 2 Public Const PROGRESS_QUIET As Long = 3 '#define PROGRESS_QUIET 3 Public Const CALLBACK_CHUNK_FINISHED As Long = &H0 '#define CALLBACK_CHUNK_FINISHED 0x00000000 Public Const CALLBACK_STREAM_SWITCH As Long = &H1 '#define CALLBACK_STREAM_SWITCH 0x00000001 Public Const COPY_FILE_FAIL_IF_EXISTS As Long = &H1 '#define COPY_FILE_FAIL_IF_EXISTS 0x00000001 Public Const COPY_FILE_RESTARTABLE As Long = &H2 '#define COPY_FILE_RESTARTABLE 0x00000002 Public Const COPY_FILE_OPEN_SOURCE_FOR_WRITE As Long = &H4 '#define COPY_FILE_OPEN_SOURCE_FOR_WRITE 0x00000004 Public Declare Function GetLastError Lib "kernel32" () As Long 'CopyFileExA(LPCSTR lpExistingFileName, LPCSTR lpNewFileName, LPPROGRESS_ROUTINE lpProgressRoutine OPTIONAL, LPBOOL pbCancel OPTIONAL, DWORD dwCopyFlags); Public Declare Function CopyFileExA Lib "kernel32" (ByVal lpExistingFileName As String, ByVal lpNewFileName As String, ByVal lpProgressRoutine As Long, ByVal lpData As Long, ByVal pbCancel As Long, ByVal dwCopyFlags As Long) As Boolean Private bCancel As Boolean 'Cancel flag Public Function CopyProgressRoutine(ByVal TotalFileSize As Currency, _ ByVal TotalBytesTransferred As Currency, _ ByVal StreamSize As Currency, _ ByVal StreamBytesTransferred As Currency, _ ByVal dwStreamNumber As Long, _ ByVal dwCallbackReason As Long, _ ByVal hSourceFile As Long, _ ByVal hDestinationFile As Long, _ lpData As Long) As Long Debug.Print Round(StreamBytesTransferred / TotalFileSize * 100) CopyProgressRoutine = PROGRESS_CONTINUE End Function Public Sub Main() On Error GoTo ErrTrap Dim lReturn As Long Dim lLastDLLError As Long Dim lLastGetError As Long lReturn = CopyFileExA("C:\MyLargeSourceFile" & vbNullChar, _ "C:\MyLargeTargetFile" & vbNullChar, _ AddressOf CopyProgressRoutine, _ vbNull, _ VarPtr(bCancel), _ COPY_FILE_RESTARTABLE) If lReturn = ERROR_SUCCESS Then lLastDLLError = Err.LastDllError lLastGetError = GetLastError() MsgBox "GetLastError returned: " & lLastGetError & vbCrLf & "Err.LastDllError is: " & lLastDLLError End If Exit Sub ErrTrap: MsgBox Err.Number & " - " & Err.Description End Sub





Reply With Quote