Visual Basic File API Routines
CopyFile: Copy Files En-mass to a New Folder
     
Posted:   Thursday September 9, 1999
Updated:   Monday December 26, 2011
     
Applies to:   VB4-32, VB5, VB6
Developed with:   VB6, Windows NT4
OS restrictions:   None
Author:   VBnet - Randy Birch
     
 Prerequisites
None.

This code demonstrates how to use the CopyFile() API to copy a set of files of the same filespec from the source folder to a new destination folder. If he destination folder does not exist, it is created. The copied files are listed in a listbox for debugging purposes.
 BAS Module Code
None.

 Form Code
Start a new project, and to the form add two command buttons (Command1 and Command2), and a listbox (List1). Add the following code to the form:

Option Explicit
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Copyright ©1996-2011 VBnet/Randy Birch, All Rights Reserved.
' Some pages may also contain other copyrights by the author.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Distribution: You can freely use this code in your own
'               applications, but you may not reproduce 
'               or publish this code on any web site,
'               online service, or distribute as source 
'               on any media without express permission.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
PrivateConst INVALID_HANDLE_VALUE = -1
PrivateConst MAX_PATH As Long = 260

PrivateType FILETIME
     dwLowDateTime As Long
     dwHighDateTime As Long
  End Type

PrivateType 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

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

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

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

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

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

PrivateDeclare Function FindClose Lib "kernel32" _
      (ByVal hFindFile As Long) As Long
      

Private Sub Command1_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 Command2_Click()

   Unload Me
   
End Sub


PrivateFunction 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
 Comments
Save the project and set the correct paths and filespec to use in the Command1 sub before running.

 
 

PayPal Link
Make payments with PayPal - it's fast, free and secure!

 
 
 
 

Copyright ©1996-2011 VBnet and Randy Birch. All Rights Reserved.
Terms of Use  |  Your Privacy

 

 

Hit Counter