On a form that has a Button to start copy, a Button to cancel the copy, a VB progressbar to show copy progress and a Label to indicate success.
Sub cmdStartCopy_Click()
CancelBackup = False
if CopyTheFile (Me, SourcePathAndFilename, TargetPathAndFilename)= 1 then
lblAdvice.Caption="Copy Successful"
Else
lblAdvice.Caption="Copy failed"
End If
'Source and Target must include file title
'Eg (Me, "C:\LocalVideoFolder\MyNewVideo.avi", "\\10.290.255.123\C\RemoteVideoFolder\MyNewVideo.avi")
End Sub
Sub cmdCancelCopy()
CancelBackup=True
End Sub
--------------------------------------------
In a Module
Option Explicit
Public CancelBackup As Long
Private MyFileTitle As String
'Define possible return codes from the CopyFileEx callback routine
Private Const PROGRESS_CONTINUE As Long = 0
Private Const PROGRESS_CANCEL As Long = 1
'CopyFileEx callback routine state change values
Private Const CALLBACK_CHUNK_FINISHED As Long = &H0
Private MyFormName As Form
Private Const CALLBACK_STREAM_SWITCH As Long = &H1
Private Const COPY_FILE_RESTARTABLE As Long = &H2
Private Declare Function CopyFileEx Lib "kernel32" _
Alias "CopyFileExA" _
(ByVal lpExistingFileName As String, _
ByVal lpNewFileName As String, _
ByVal lpProgressRoutine As Long, _
lpData As Any, _
pbCancel As Long, _
ByVal dwCopyFlags As Long) As Long
Public Function CopyTheFile(InFormName As Form, sSourceFile As String, sTargetFile As String) As Boolean
Set MyFormName = InFormName
Dim lpCallback As Long
lpCallback = FARPROC(AddressOf CopyProgressCallback)
CopyTheFile = CopyFileEx(sSourceFile, _
sTargetFile, _
lpCallback, _
0&, _
CancelBackup, _
COPY_FILE_RESTARTABLE) = 1
'if CopyFileEx succeeds, the return value is 1. A failure returns 0.
End Function
Private Function FARPROC(ByVal pfn As Long) As Long
'passes the addressof the callback procedure to the
'CopyFileEx lpCallback member. Because AddressOf
'can not be assigned directly, use a roundabout
'means by passing the address to a function
'that returns the same.
FARPROC = pfn
End Function
Private Function CopyProgressCallback(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
'Show copy progress on a ProgressBar on the main form
Select Case dwCallbackReason
Case CALLBACK_STREAM_SWITCH:
'happens when callback is initialized for each file.
MyFormName.ProgressBar1.Value = 0
MyFormName.ProgressBar1.Min = 0
MyFormName.ProgressBar1.Max = (TotalFileSize * 10000)
MyFormName.ProgressBar1.Refresh
CopyProgressCallback = PROGRESS_CONTINUE
Case CALLBACK_CHUNK_FINISHED
'happens when a block has been copied
MyFormName.ProgressBar1.Value = (TotalBytesTransferred * 10000)
DoEvents
If CancelBackup = False Then
CopyProgressCallback = PROGRESS_CONTINUE
Else
CopyProgressCallback = PROGRESS_CANCEL 'stop coying
End If
End Select
End Function
