DEVelopers HUT

'---------------------------------------------------------------------------------------
' Procedure : MoveFolder
' Author    : CARDA Consultants Inc.
' Website   : http://www.cardaconsultants.com
' Purpose   : Move a folder
'             Better version of the FSO's MoveFolder method which is basically a "rename"
'             method, hence it only works if the source and destination reside on
'             the same volume (same as move.exe under WinXP) and typically returns
'             a permission denied error.
' Copyright : The following may be altered and reused as you wish so long as the
'             copyright notice is left unchanged (including Author, Website and
'             Copyright).  It may not be sold/resold or reposted on other sites (links
'             back to this site are allowed).
'
' Input Variables:
' ~~~~~~~~~~~~~~~~
' sFolderSource         Folder to move
' sFolderDestination    Folder to move the folder to
' bOverWriteFiles       Whether to overwrite file(s) if the folder already exists
'
' Usage Example:
' ~~~~~~~~~~~~~~~~
' MoveFolder("C:\Temp", "D:\Development\New")
'
' Revision History:
' Rev       Date(yyyy/mm/dd)        Description
' **************************************************************************************
' 1         2010-Nov-14                 Initial Release
'---------------------------------------------------------------------------------------
Function MoveFolder(sFolderSource As String, sFolderDestination As String, _
                    bOverWriteFiles As Boolean) As Boolean
On Error GoTo Error_Handler
    Dim fs As Object
 
    MoveFolder = False
    Set fs = CreateObject("Scripting.FileSystemObject")
    fs.CopyFolder sFolderSource, sFolderDestination, bOverWriteFiles
    fs.DeleteFolder sFolderSource, True
    MoveFolder = True
 
Error_Handler_Exit:
    On Error Resume Next
    Set fs = Nothing
    Exit Function
 
Error_Handler:
    If Err.Number = 76 Then
        MsgBox "The 'Source Folder' could not be found to make a copy of.", _
                vbCritical, "Unable to Find the Specified Folder"
    Else
        MsgBox "The following error has occured" & vbCrLf & vbCrLf & _
               "Error Number: " & Err.Number & vbCrLf & _
               "Error Source: MoveFolder" & vbCrLf & _
               "Error Description: " & Err.Description, _
               vbCritical, "An Error has Occured!"
    End If
    Resume Error_Handler_Exit
End Function