Visual Basic Win32 Shell Routines
SHFileOperation: Copy or Move an Entire Directory
     
Posted:   Sunday January 26, 1997
Updated:   Monday December 26, 2011
     
Applies to:   VB4-32, VB5, VB6
Developed with:   VB4-32, Windows 95
OS restrictions:   None
Author:   VBnet - Randy Birch
     

Related:  

SHFileOperation: Add Recycle Bin Functionality
SHFileOperation: Copy, Move or Delete Files
SHQueryRecycleBin: Recycle Bin Management
       
 Prerequisites
None.

As shown in SHFileOperation: Add Recycle Bin Functionality and SHFileOperation: Copy, Move or Delete Files, Windows offers the option of sending files to the recycle bin using the SHFileOperation API. However, this same API can also be used to copy individual files, or, as detailed below, to copy or move an entire folder and its contents, including subfolders, to a new destination.

It must be noted up front that the following code, for simplicity, does not provide for any checking of the validity of the source or destinations entered, nor does it distinguish between a folder and a drive. Therefore, use caution, or you could accidentally copy drive C:\ into a folder!!

 

 

 BAS Module Code
None.

 Form Code
Start a new project and to a new form add:
  • four command buttons (Command1(0), Command1(1), Command2 and Command3)
  • two text boxes (Text1 and Text2)
  • an array of option buttons (Option1(1) and Option1(2), assuring that the indexes are as indicated, so as to correspond to the related constants for copying or moving.
  • an array of check boxes (Check1(0) - Check1(4)).

Set the Locked property (VB5/VB6 only) for both text boxes to True, and set the control captions as indicated in the illustration. Finish the form off by adding labels. The frames used in the example are optional.

Add the following 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.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Type SHFILEOPSTRUCT
   hWnd        As Long
   wFunc       As Long
   pFrom       As String
   pTo         As String
   fFlags      As Integer
   fAborted    As Boolean
   hNameMaps   As Long
   sProgress   As String
 End Type
  
Private Const FO_MOVE As Long = &H1
Private Const FO_COPY As Long = &H2
Private Const FO_DELETE As Long = &H3
Private Const FO_RENAME As Long = &H4

Private Const FOF_SILENT As Long = &H4
Private Const FOF_RENAMEONCOLLISION As Long = &H8
Private Const FOF_NOCONFIRMATION As Long = &H10
Private Const FOF_SIMPLEPROGRESS As Long = &H100
Private Const FOF_ALLOWUNDO As Long = &H40

Private Declare Function GetTempPath Lib "kernel32" _
     Alias "GetTempPathA" _
    (ByVal nSize As Long, ByVal lpBuffer As String) As Long

Private Declare Function SHFileOperation Lib "shell32" _
    Alias "SHFileOperationA" _
    (lpFileOp As SHFILEOPSTRUCT) As Long
  
Private Declare Function SHGetPathFromIDList Lib "shell32" _
    Alias "SHGetPathFromIDListA" _
    (ByVal pidl As Long, ByVal pszPath As String) As Long
       
Private Declare Function SHGetSpecialFolderLocation Lib "shell32" _
    (ByVal hwndOwner As Long, _
     ByVal nFolder As Long, _
     pidl As Long) As Long
   
Private Declare Function SHBrowseForFolder Lib "shell32" _
    Alias "SHBrowseForFolderA" _
    (lpBrowseInfo As BROWSEINFO) As Long
   
Private Type BROWSEINFO
   hOwner           As Long
   pidlRoot         As Long
   pszDisplayName   As String
   lpszTitle        As String
   ulFlags          As Long
   lpfn             As Long
   lParam           As Long
   iImage           As Long
End Type
   
Private Const ERROR_SUCCESS As Long = 0
Private Const CSIDL_DESKTOP As Long = &H0   
Private Const BIF_RETURNONLYFSDIRS As Long = &H1
Private Const BIF_STATUSTEXT As Long = &H4
Private Const BIF_RETURNFSANCESTORS As Long = &H8
         

'FO_FUNC - the File Operation to perform,
'determined by the type of SHFileOperation
'action chosen (move/copy)
Dim FO_FUNC As Long
 
'for ease of reading, constants are substituted
'for SHFileOperation numbers in code
Const FileMove As Integer = 1
Const FileCopy As Integer = 2
  
'Check button index constants
Const optSilent As Integer = 0
Const optNoFilenames As Integer = 1
Const optNoConfirmDialog As Integer = 2
Const optRenameIfExists As Integer = 3
Const optPromptMeFirst As Integer = 4

'strings to hold paths for this demo
Dim source As String
Dim destination As String
   

Private Sub Form_Load()

   Me.Move (Screen.Width - Me.Width) \ 2, (Screen.Height - Me.Height) \ 2
   Option1(FileCopy).Value = True
   
   Command1(0).Caption = "Select Source"
   Command1(1).Caption = "Select Target"
   Command2.Caption = "Perform Action"
   Command3.Caption = "End"
   Option1(1).Caption = "Move Source Folder to Destination"
   Option1(2).Caption = "Copy Source Folder to Destination"
   Check1(0).Caption = "Don't show operation (no copy dialog)"
   Check1(1).Caption = "Don't show filenames for multiple deletes"
   Check1(2).Caption = "Don't prompt for confirmation"
   Check1(3).Caption = "Rename file if target name already exists"
   Check1(4).Caption = "Whoa !! Prompt me before doing it !"   
         
End Sub


Private Sub Command1_Click(Index As Integer)

   Dim tmp As String
   
   Select Case Index
      Case 0:
         tmp = GetBrowseFolder("Select the SOURCE to move or copy:")
         
         If Len(tmp) > 0 Then
            source = tmp
            Text1.Text = source
         End If
    
      Case 1:
         tmp = GetBrowseFolder("Select the folder DESTINATION:")
         
         If Len(tmp) > 0 Then
            destination = tmp
            Text2.Text = destination
         End If
         
   End Select

End Sub


Private Sub Command2_Click()

   Dim msg As String
   Dim action As Boolean
   
  'First, assume the user WILL want to perform the
  'action, in case they don't want prompting
   action = True
   
  'check if they've asked to be prompted about the action...
   If Check1(optPromptMeFirst).Value = 1 Then
   
      msg = "You have chosen to move or copy the folder and contents of :" & vbCrLf
      msg = msg & source & vbCrLf & vbCrLf
      msg = msg & "to the destination:" & vbCrLf
      msg = msg & destination & vbCrLf & vbCrLf
      msg = msg & "Are you sure that you want to proceed with this action?"
  
    'since they want to be prompted, set the action
    'based on their response to a messagebox.
    '
    'Two buttons are presented - Yes and No.
    '
    'If No is selected, the the return value from the
    'messagebox is vbNo. When that is compared with
    'vbYes in the expression, the result is FALSE, therefore
    'the action variable will be set to false.
    '
    'If Yes is selected, the the return value from the
    'messagebox is vbYes, which equals vbYes, therefore
    'the expression will return TRUE to the action variable
     action = MsgBox(msg, vbExclamation Or vbYesNo, "Warning") = vbYes
      
   End If
   
   If action = True Then 
      PerformShellAction source, destination
   End If
   
End Sub


Private Sub Command3_Click()

   Unload Me
   
End Sub


Private Sub Option1_Click(Index As Integer)

  'set the file action flag
   FO_FUNC = CLng(Index)

End Sub


Public Function PerformShellAction(sSource As String, _
                                   sDestination As String) As Long

   Dim FOF_FLAGS As Long
   Dim SHFileOp As SHFILEOPSTRUCT
   
  'terminate the folder string with a pair of nulls
   sSource = sSource & Chr$(0) & Chr$(0)
  
  'determine the user's options selected
   FOF_FLAGS = BuildBrowseFlags()
  
  'set up the options
   With SHFileOp
      .wFunc = FO_FUNC
      .pFrom = sSource
      .pTo = sDestination
      .fFlags = FOF_FLAGS
   End With
  
  'and perform the chosen copy or move operation
   PerformShellAction = SHFileOperation(SHFileOp)

End Function


Private Function BuildBrowseFlags() As Long

 'Iterate through the options, and build 
 'the flag variable according to the user selection.

  Dim flag As Long
   
 'these can be multiple
  If Check1(optSilent).Value Then flag = flag Or FOF_SILENT
  If Check1(optNoFilenames).Value Then flag = flag Or FOF_SIMPLEPROGRESS
  If Check1(optNoConfirmDialog).Value Then flag = flag Or FOF_NOCONFIRMATION
  If Check1(optRenameIfExists).Value Then flag = flag Or FOF_RENAMEONCOLLISION
  
  BuildBrowseFlags = flag

End Function


Private Function GetBrowseFolder(msg) As String

   Dim pidl As Long
   Dim pos As Integer
   Dim path As String
   Dim bi As BROWSEINFO
  
  'Fill the BROWSEINFO structure with the needed data,
  'show the browse dialog, and if the returned value
  'indicates success (1), retrieve the user's
  'selection contained in pidl   
   With bi
      .hOwner = Me.hWnd
      .pidlRoot = CSIDL_DESKTOP
      .lpszTitle = msg
      .ulFlags = BIF_RETURNONLYFSDIRS
   End With

   pidl = SHBrowseForFolder(bi)
 
   path = Space$(512)
     
   If SHGetPathFromIDList(ByVal pidl, ByVal path) = 1 Then
      pos = InStr(path, Chr$(0))
      GetBrowseFolder = Left(path, pos - 1)
   End If

End Function
 Comments
directorycopymsg.gif (2983 bytes)Run the project and select both a source folder (the folder to copy or move) and a destination for it. The destination can be another folder on the same drive, on a different drive, or the drive root. Select a move or copy action, and any of the options you would like to test. Selecting the item "Rename the file if it already exists" will perform the action and create a new folder with the prefix "Copy of" should a folder of the same name already exists.

The code in the Command2_Click sub checks to see whether the "Prompt before doing it" check button has been selected. If it has (recommended), a messagebox pops up providing a last-chance to abort the procedure.

Finally, when a folder is about to be copied overtop an existing folder, and if the "Don't prompt for confirmation" checkbox is not checked, then the overwrite dialog will appear as shown.

 


 
 

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