File Copy Progress Monitoring

How to Copy Files En-mass to a New Folder Using the CopyFile API

http://www.mvps.org/vbnet/code/fileapi/copyfile.htm

Option Explicit

  Public Const INVALID_HANDLE_VALUE = -1
  Public Const MAX_PATH = 260

  Type FILETIME
     dwLowDateTime As Long
     dwHighDateTime As Long
  End Type

  Type WIN32_FIND_DATA
     dwFileAttributes As Long
     ftCreationTime As FILETIME
     ftLastAccessTime As FILETIME
     ftLastWriteTime As FILETIME
     nFileSizeHigh As Long
     nFileSizeLow As Long
     dwReserved0 As Long
     dwReserved1 As Long
     cFileName As String * MAX_PATH
     cAlternate As String * 14
  End Type

  Type SECURITY_ATTRIBUTES
     nLength As Long
     lpSecurityDescriptor As Long
     bInheritHandle As Long
  End Type

  Declare Function CreateDirectory Lib "kernel32" Alias "CreateDirectoryA" _
      (ByVal lpPathName As String, _
       lpSecurityAttributes As SECURITY_ATTRIBUTES) As Long

  Declare Function CopyFile Lib "kernel32" Alias "CopyFileA" _
      (ByVal lpExistingFileName As String, _
       ByVal lpNewFileName As String, _
       ByVal bFailIfExists As Long) As Long

  Declare Function FindFirstFile Lib "kernel32" Alias "FindFirstFileA" _
      (ByVal lpFileName As String, _
      lpFindFileData As WIN32_FIND_DATA) As Long

  Declare Function FindNextFile Lib "kernel32" Alias "FindNextFileA" _
      (ByVal hFindFile As Long, _
       lpFindFileData As WIN32_FIND_DATA) As Long

  Declare Function FindClose Lib "kernel32" _
      (ByVal hFindFile As Long) As Long
'--end block--'
   

 Form Code
 
Add the following code to the form:

--------------------------------------------------------------------------------
 

Private Sub cmdCopyFiles_Click()

   Dim sSourcePath As String
   Dim sDestination As String
   Dim sFiles As String
   Dim numCopied As Long
     
  'set the appropriate initializing values  
   sSourcePath = "c:\win\"
   sDestination = "c:\temptest\"
   sFiles = "*.txt"
     
  'perform the copy and return the copied file count  
   numCopied = rgbCopyFiles(sSourcePath, sDestination, sFiles)
   
   MsgBox numCopied & " files copied to " & sDestination

End Sub


Private Sub cmdEnd_Click()

   Unload Me
   End
   
End Sub


Public Function rgbCopyFiles(sSourcePath As String, _
                             sDestination As String, _
                             sFiles As String) As Long

   Dim WFD As WIN32_FIND_DATA
   Dim SA As SECURITY_ATTRIBUTES
   
   Dim r As Long
   Dim hFile As Long
   Dim bNext As Long
   Dim copied As Long
   Dim currFile As String
     
  'Create the target directory if it doesn't exist  
   Call CreateDirectory(sDestination, SA)
   
  'Start searching for files in the Target directory.  
   hFile = FindFirstFile(sSourcePath & sFiles, WFD)
   
   If (hFile = INVALID_HANDLE_VALUE) Then
     
      'nothing to do, so bail out  
       MsgBox "No " & sFiles & " files found."
       Exit Function
 
   End If
     
  'Copy each file to the new directory
   If hFile Then
     
      Do
       
        'trim trailing nulls, leaving one to terminate the string  
         currFile = Left$(WFD.cFileName, InStr(WFD.cFileName, Chr$(0)))
           
        'copy the file to the destination directory & increment the count
         Call CopyFile(sSourcePath & currFile, sDestination & currFile, False)
         copied = copied + 1
           
        'just to check what's happening  
         List1.AddItem sSourcePath & currFile
         
        'find the next file matching the initial file spec  
         bNext = FindNextFile(hFile, WFD)
               
      Loop Until bNext = 0
     
   End If
     
  'Close the search handle  
   Call FindClose(hFile)
     
  'and return the number of files copied  
   rgbCopyFiles = copied
   
End Function


Take also a look here :
http://support.microsoft.com/support/kb/articles/q165/9/19.asp

put the following on a class module:

Option Explicit

Private Declare Function DestroyWindow Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function CreateWindowEx Lib "user32" Alias "CreateWindowExA" (ByVal dwExStyle As Long, ByVal lpClassName As String, ByVal lpWindowName As String, ByVal dwStyle As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hWndParent As Long, ByVal hMenu As Long, ByVal hInstance As Long, lpParam As Any) As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long

Private Type tagInitCommonControlsEx
    lngSize As Long
    lngICC As Long
End Type
 
Private Declare Function InitCommonControlsEx Lib "Comctl32.dll" _
 (iccex As tagInitCommonControlsEx) As Boolean

Private Const ICC_ANIMATE_CLASS = &H80
Private Const ANIMATE_CLASS = "SysAnimate32"
Private Const WM_USER = &H400&
Private Const ACS_CENTER = &H1&
Private Const ACS_TRANSPARENT = &H2&
Private Const ACS_AUTOPLAY = &H4&
Private Const ACM_OPEN = WM_USER + 100
Private Const ACM_PLAY = WM_USER + 101
Private Const ACM_STOP = WM_USER + 102
Private Const WS_EX_TRANSPARENT = &H20&
Private AnimateHwnd As Long
Private StaticWin As Long
 

Public Sub Create(ByVal hwnd As Long, ByVal StrAVI As String, ByVal Left As Long, ByVal Top As Long, ByVal width As Long, ByVal height As Long)
   
    StaticWin = CreateWindowEx(WS_EX_TRANSPARENT, _
    ANIMATE_CLASS, _
    "", _
     &H50000007, _
    Left, Top, width, height, _
    hwnd, 0&, App.hInstance, ByVal 0&)
   
   
    AnimateHwnd = CreateWindowEx(WS_EX_TRANSPARENT, _
    ANIMATE_CLASS, _
    "", _
     &H50000007, _
    Left, Top, width, height, _
    StaticWin, 0&, App.hInstance, ByVal 0&)
   
   
    SendMessage AnimateHwnd, ACM_OPEN Or ACS_AUTOPLAY, 0&, ByVal StrAVI
 

End Sub

Public Sub AnimatePlay()
    SendMessage AnimateHwnd, ACM_PLAY, -1, 0
End Sub

Public Sub AnimateStop()
    SendMessage AnimateHwnd, ACM_STOP, 0, 0
End Sub

Public Sub Destroy()
    AnimateStop
    DestroyWindow AnimateHwnd
    DestroyWindow StaticWin
     
End Sub


Public Sub AutoPlay()
    SendMessage AnimateHwnd, ACS_AUTOPLAY, -1, 0
End Sub

Private Sub Class_Initialize()
 Dim iccex As tagInitCommonControlsEx
    With iccex
        .lngSize = LenB(iccex)
        .lngICC = ICC_ANIMATE_CLASS
    End With
    Call InitCommonControlsEx(iccex)
     
End Sub

and the following on your code:
Private Animate As New CAnimate32



Private Sub Form_Load()
On Error Resume Next
 
If Dir(App.Path & "\FILECOPY.AVI") = "" Then
MsgBox "Unable to find AVI"
Unload Me
End If

Animate.Create Me.hwnd, App.Path & "\FILECOPY.AVI", -5, 0, 300, 50
 
Animate.AnimatePlay
 
Me.Show
 
 
 
End Sub

Hehehe, you have one answer showing you how to copy a bunch of files and one answer on how to make an animation class.  I try the last option, actually using the Windows File Copy Dialog.

This function is slightly modified from Bruce McKinney's Hard Core Visual Basic 2, highly recommended (although he didn't have positive comments for the designers of VB6).

Private Declare Function SHFileOperation Lib "shell32.dll" _
  Alias "SHFileOperationA" (lpFileOp As SHFILEOPSTRUCT) As Long

Private Type SHFILEOPSTRUCT
  hWnd As Long
  wFunc As Long
  pFrom As String
  pTo As String
  fFlags As Integer
  fAnyOperationsAbortedLo As Integer
  fAnyOperationsAbortedHi As Integer
  hNameMappingsLo As Long
  hNameMappingsHi As Long
  lpszProgressTitleLo As Long
  lpszProgressTitleHi As Long
End Type

Public Const FO_COPY = &H2
Public Const FOF_SILENT = &H4                      
Public Const FOF_SIMPLEPROGRESS = &H100            
Public Const FOF_COPYFLAGS = &H3DD

' Better version of FileCopy
Function CopyAnyFile(sSrc As String, sDst As String, _
                     Optional Options As Long = 0, _
                     Optional Owner As Long = hNull) As Boolean
    Dim fo As SHFILEOPSTRUCT, f As Long
    fo.wFunc = FO_COPY
    Debug.Print TypeName(fo.wFunc)
    fo.pFrom = sSrc
    fo.pTo = sDst
    fo.fFlags = Options
    fo.hWnd = Owner
    ' Mask out invalid flags
    fo.fFlags = fo.fFlags And FOF_COPYFLAGS
    f = SHFileOperation(fo)
    CopyAnyFile = (f = 0)
End Function


Use if conjuction with waty's answer to copy a bunch of files.
Good luck.

oops, you are right ryanvs, I have made a bad copy paste :< for the second

If you want to just try my FileCopier sample at http://www.zebra.net/~adrianm/pages/samples.htm 

It does exactly what you want to do and the FileCopier class is already nice and ready to use.

Adrian

Thanks for that guys!
Lot's to take in there at one sitting, so you'll forgive me if I take some time to absorb the wealth of information you have provided!

I'm sure this is a good answer but I'm rejecting this as I was lazy and looked at adrianmaul's self-contained sample first and it does the job very nicely, so I'll give adrianmaull the points if he answers the question again.
Thanks very much to all who answered/commented.

it seems that i have to know exactly what you need from now on

Cheers!