VBA Copy Files Using FileSystemObject

VBA FileSystemObject;Copy VBA FileSystemObject;Copy Files Using VBA FileSystemObject;copies one file from one folder to another folder with the VBA FileSystemObject

VBA code to copy file from one folder to another folder using FileSystemObject:

 Sub CopyFile(SourceFilePath As String, DestPath As String, OverWrite As Boolean)  
 ' (1) copies one file from one folder to another folder with the VBA FileSystemObject  
 ' (2) contains extensive error handling (safeguards)  
 ' (3) requires a reference to the object library "Microsoft Scripting Runtime" under Options > Tools > References... in the Visual Basic Editor.  
 Dim blFileExists As Boolean, blSourceErr As Boolean  
 Dim strFileName As String, strSuccessMsg As String, strNewDestPath As String, strNewSourcePath As String  
 Dim FSO As Scripting.FileSystemObject  
 Dim strErrMsg As String  
 Set FSO = New Scripting.FileSystemObject  
 'Set FSO = VBA.CreateObject("Scripting.FileSystemObject")  
 With FSO  
 strNewDestPath = .BuildPath(.GetAbsolutePathName(DestPath), "\")  
 strFileName = .GetFileName(SourceFilePath)  
 'check if the source file exists  
 If Not .FileExists(SourceFilePath) Then  
 ' check if the root drive was specified  
 If .DriveExists(Left(SourceFilePath, 2)) Then  
 blSourceErr = True  
 ' the provided source path is incomplete  
 ' build new path and ask the user if he accepts the suggestion  
 Else  
 strNewSourcePath = .BuildPath(.GetAbsolutePathName(SourceFilePath), "")  
 If Not MsgBox("The source path " & Chr(34) & SourceFilePath & Chr(34) & _  
 " is incomplete. Will you accept the following suggestion: " _  
 & Chr(34) & strNewSourcePath & Chr(34) & "?", vbYesNo, "Confirm new source path") = vbYes Then _  
 blSourceErr = True  
 End If  
 ' error  
 If blSourceErr Then _  
 strErrMsg = "The source file," & Chr(34) & strFileName & Chr(34) & _  
 " does not exist, or the specified path to the file, " & Chr(34) & _  
 Replace(SourceFilePath, strFileName, "") & Chr(34) & " is incorrect."  
 ' check if the destination folder already exists  
 ElseIf Not .FolderExists(strNewDestPath) Then  
 ' prompt the user if the destination folder should be created  
 If MsgBox("The destination folder, " & Chr(34) & strNewDestPath & Chr(34) & ", does not exist. Do you want to create it?", vbYesNo, _  
 "Create new folder?") = vbYes Then  
 .CreateFolder (strNewDestPath)  
 Else  
 strErrMsg = "The destination folder could not be created."  
 End If  
 ' check if the file already exists in the destination folder  
 Else  
 blFileExists = .FileExists(strNewDestPath & strFileName)  
 If Not OverWrite Then  
 If blFileExists Then _  
 strErrMsg = "The file, " & Chr(34) & strFileName & Chr(34) & _  
 ", already exists in the destination folder, " & Chr(34) & _  
 strNewDestPath & Chr(34) & "."  
 End If  
 End If  
 ' attempt to copy file  
 If strErrMsg = vbNullString Then  
 On Error Resume Next  
 If strNewSourcePath = vbNullString Then strNewSourcePath = SourceFilePath  
 Call .CopyFile(strNewSourcePath, strNewDestPath, OverWrite)  
 If Err.Number <> 0 Then strErrMsg = "Run-time error " & Err.Number & Chr(10) & Err.Description  
 On Error GoTo 0  
 End If  
 ' succesful copy  
 If strErrMsg = vbNullString Then  
 strSuccessMsg = "The file" & Chr(34) & strFileName & Chr(34) & " was copied to " & _  
 Chr(34) & strNewDestPath & Chr(34) & "."  
 If blFileExists Then strSuccessMsg = strSuccessMsg & Chr(10) & _  
 "(Note, the existing file in the destination folder was overwritten)."  
 MsgBox strSuccessMsg, vbInformation, "File copied"  
 ' error  
 Else  
 MsgBox strErrMsg, vbCritical, "Error!"  
 End If  
 End With  
 Set FSO = Nothing  
 End Sub