MoveDirs

Public Const FO_MOVE = &H1
Public Const FO_COPY = &H2
Public Const FOF_SILENT = &H4
Public Const FOF_RENAMEONCOLLISION = &H8
Public Const FOF_NOCONFIRMATION = &H10
Public Const FOF_SIMPLEPROGRESS = &H100
Public Const FOF_ALLOWUNDO = &H40
Public Declare Function SHFileOperation Lib "shell32.dll" Alias "SHFileOperationA" _
    (lpFileOp As SHFILEOPSTRUCT) As Long
Public Declare Function GetTempPath Lib "kernel32" Alias "GetTempPathA" _
    (ByVal nSize As Long, ByVal lpBuffer As String) As Long

'we'll use Brad's Browse For Folders Dialog code to enable the user
'to pick the source and destination folders.
Type SHITEMID
    cb As Long
    abID As Byte
End Type
Type ITEMIDLIST
    mkid As SHITEMID
End Type

Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias "SHGetPathFromIDListA" _
    (ByVal pidl As Long, ByVal pszPath As String) As Long
Declare Function SHGetSpecialFolderLocation Lib "shell32.dll" _
    (ByVal hwndOwner As Long, ByVal nFolder As Long, pidl As ITEMIDLIST) As Long
Declare Function SHBrowseForFolder Lib "shell32.dll" Alias "SHBrowseForFolderA" _
    (lpBrowseInfo As BROWSEINFO) As Long
Public 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
Public Const NOERROR = 0
Public Const CSIDL_DESKTOP = &H0
Public Const BIF_RETURNONLYFSDIRS = &H1
Public Const BIF_STATUSTEXT = &H4
Public Const BIF_RETURNFSANCESTORS = &H8
'Add the following code to the general declarations section of Form1.
Option Explicit
'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 the paths
Dim source As String
Dim destination As String

Private Sub Form_Load()
    optSHFileAction(FileCopy).Value = True
End Sub

Private Sub cmdEnd_Click()
    Unload Me
    Set Form1 = Nothing
    End
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 Sub cmdGetFolders_Click(Index As Integer)
    Dim tmp As String
    Select Case Index
        Case 0:
            tmp = GetBrowseFolder("Select the SOURCE folder to move or copy:")
            
            If tmp > "" Then
                source = tmp
                txtSource = source
            End If
            
        Case 1:
            tmp = GetBrowseFolder("Select the folders DESTINATION for the action:")
            
            If tmp > "" Then
                destination = tmp
                txtDestination = destination
            End If
    End Select
End Sub

Private Sub cmdPerform_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 chkOptions(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 prompeted, 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 Sub

Private Sub optSHFileAction_Click(Index As Integer)
    'set the file action flag
    FO_FUNC = CLng(Index)
End Sub

Private Function BuildBrowseFlags() As Long
    'Iterate throught the options, and build the flag variable
    'according to the user selection.
    Dim flag As Long
    
    'First, start off empty
    flag = 0&
    
    'these can be multiple
    If chkOptions(optSilent).Value Then flag = flag Or FOF_SILENT
    If chkOptions(optNoFilenames).Value Then flag = flag Or FOF_SIMPLEPROGRESS
    If chkOptions(optNoConfirmDialog).Value Then flag = flag Or FOF_NOCONFIRMATION
    If chkOptions(optRenameIfExists).Value Then flag = flag Or FOF_RENAMEONCOLLISION
    
    BuildBrowseFlags = flag
End Function

Private Function GetBrowseFolder(msg) As String
    Dim r As Long
    Dim pidl As Long
    Dim pos As Integer
    Dim path As String
    Dim bi As BROWSEINFO
    Dim IDL As ITEMIDLIST
    
    '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&
    
    bi.hOwner = Me.hWnd
    bi.pidlRoot = CSIDL_DESKTOP
    bi.lpszTitle = msg
    bi.ulFlags = BIF_RETURNONLYFSDIRS
    
    pidl& = SHBrowseForFolder(bi)
    
    path$ = Space$(512)
    r& = SHGetPathFromIDList(ByVal pidl&, ByVal path$)
    
    If r& = 1 Then
        pos = InStr(path$, Chr$(0))
        GetBrowseFolder = Left(path$, pos - 1)
    End If
End Function

As shown in the code Utilizing Windows Recycle Bin and Utilizing Windows
SHFileOperation API, Advanced, Windows 95 and NT4 offer 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 does not provide for any
checking of the validity of the source or destinations selection, nor does
it distinguish between a folder and a drive. Therefore, use caution, or you
could accidentally copy drive C:\ into a folder!!
Start a new project, and create a form like the illustration: add a four
command buttons (cmdGetFolders(0), cmdGetFolders(1), cmdPerform and cmdEnd),
two text boxes (txtSource and txtDestination), an array of option buttons
(optSHFileAction(1) and optSHFileAction(2), and an array of check boxes
(chkOptions(0) - chkOptions(5)). Set the Locked property (VB5) for both text
boxes to True, and captions of the controls as indicated in the illustration
 Finish the form off by adding labels. The frames used in the example are
optional.
Once this has been completed, add the following code to a bas module:

Option Explicit
Public 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

Public Const FO_MOVE = &H1
Public Const FO_COPY = &H2
Public Const FOF_SILENT = &H4
Public Const FOF_RENAMEONCOLLISION = &H8
Public Const FOF_NOCONFIRMATION = &H10
Public Const FOF_SIMPLEPROGRESS = &H100
Public Const FOF_ALLOWUNDO = &H40
Public Declare Function SHFileOperation Lib "shell32.dll" Alias "SHFileOperationA" _
(lpFileOp As SHFILEOPSTRUCT) As Long
Public Declare Function GetTempPath Lib "kernel32" Alias "GetTempPathA" _
(ByVal nSize As Long, ByVal lpBuffer As String) As Long

'we'll use Brad's Browse For Folders Dialog code to enable the user

'to pick the source and destination folders.

Type SHITEMID
cb As Long
abID As Byte
End Type
Type ITEMIDLIST
mkid As SHITEMID
End Type

Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias "SHGetPathFromIDListA" _
(ByVal pidl As Long, ByVal pszPath As String) As Long
Declare Function SHGetSpecialFolderLocation Lib "shell32.dll" _
(ByVal hwndOwner As Long, ByVal nFolder As Long, pidl As ITEMIDLIST) As Long
Declare Function SHBrowseForFolder Lib "shell32.dll" Alias "SHBrowseForFolderA" _
(lpBrowseInfo As BROWSEINFO) As Long
Public 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
Public Const NOERROR = 0
Public Const CSIDL_DESKTOP = &H0
Public Const BIF_RETURNONLYFSDIRS = &H1
Public Const BIF_STATUSTEXT = &H4
Public Const BIF_RETURNFSANCESTORS = &H8
'Add the following code to the general declarations section of Form1.

Option Explicit
'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 the paths

Dim source As String
Dim destination As String

Private Sub Form_Load()
optSHFileAction(FileCopy).Value = True
End Sub

Private Sub cmdEnd_Click()
Unload Me
Set Form1 = Nothing
End
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 Sub cmdGetFolders_Click(Index As Integer)
Dim tmp As String
Select Case Index
Case 0:
tmp = GetBrowseFolder("Select the SOURCE folder to move or copy:")

If tmp > "" Then
source = tmp
txtSource = source
End If

Case 1:
tmp = GetBrowseFolder("Select the folders DESTINATION for the action:")

If tmp > "" Then
destination = tmp
txtDestination = destination
End If
End Select
End Sub

Private Sub cmdPerform_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 chkOptions(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 prompeted, 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 Sub

Private Sub optSHFileAction_Click(Index As Integer)
'set the file action flag

FO_FUNC = CLng(Index)
End Sub

Private Function BuildBrowseFlags() As Long
'Iterate throught the options, and build the flag variable

'according to the user selection.

Dim flag As Long

'First, start off empty

flag = 0&

'these can be multiple

If chkOptions(optSilent).Value Then flag = flag Or FOF_SILENT
If chkOptions(optNoFilenames).Value Then flag = flag Or FOF_SIMPLEPROGRESS
If chkOptions(optNoConfirmDialog).Value Then flag = flag Or FOF_NOCONFIRMATION
If chkOptions(optRenameIfExists).Value Then flag = flag Or FOF_RENAMEONCOLLISION

BuildBrowseFlags = flag
End Function

Private Function GetBrowseFolder(msg) As String
Dim r As Long
Dim pidl As Long
Dim pos As Integer
Dim path As String
Dim bi As BROWSEINFO
Dim IDL As ITEMIDLIST

'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&

bi.hOwner = Me.hWnd
bi.pidlRoot = CSIDL_DESKTOP
bi.lpszTitle = msg
bi.ulFlags = BIF_RETURNONLYFSDIRS

pidl& = SHBrowseForFolder(bi)

path$ = Space$(512)
r& = SHGetPathFromIDList(ByVal pidl&, ByVal path$)

If r& = 1 Then
pos = InStr(path$, Chr$(0))
GetBrowseFolder = Left(path$, pos - 1)
End If
End Function

As shown in the code Utilizing Windows Recycle Bin and Utilizing Windows
SHFileOperation API, Advanced, Windows 95 and NT4 offer 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 does not provide for any
checking of the validity of the source or destinations selection, nor does
it distinguish between a folder and a drive. Therefore, use caution, or you
could accidentally copy drive C:\ into a folder!!
Start a new project, and create a form like the illustration: add a four
command buttons (cmdGetFolders(0), cmdGetFolders(1), cmdPerform and cmdEnd),
two text boxes (txtSource and txtDestination), an array of option buttons
(optSHFileAction(1) and optSHFileAction(2), and an array of check boxes
(chkOptions(0) - chkOptions(5)). Set the Locked property (VB5) for both text
boxes to True, and captions of the controls as indicated in the illustration
Finish the form off by adding labels. The frames used in the example are
optional.
Once this has been completed, add the following code to a bas module: