Tuesday, 2 December 2014

How to Copy the Files from Different Source Locations or Paths to Multiple Destinations

Macro to Copy the Files from Different Locations or Paths to Multiple Destinations
Sub Copy_SourceFiles_2_Destination()
Dim SrcFileName As String
Dim SrcFolderPath As String
Dim SrcFilExt As String
Dim SourceFile 'As String
Dim TargetFolderPath As String
Dim WS As Worksheet
Dim FSO As Object

'The Sheet in which we specify the Files details to Copy
Set WS = ThisWorkbook.Sheets("Bridge_Files_Trans")



Set FSO = CreateObject("Scripting.FileSystemObject")

For X = 2 To 100
If WS.Cells(X, 2) = "" Then Exit For

SrcFileName = WS.Cells(X, 2)
SrcFilExt = WS.Cells(X, 3)
SrcFolderPath = WS.Cells(X, 4)

'Setting the Source Folder path end with "\"
 If Right(SrcFolderPath, 1) <> "\" Then
        SrcFolderPath = SrcFolderPath & "\"
 End If

'Checking the Source Folder Exists or Not
If FSO.FolderExists(SrcFolderPath) = False Then
WS.Cells(X, 6) = "Failed"
MsgBox ("Source Folder Does Not Exist or Path Not Found")
GoTo Nxt:
End If

'Source File Name 
SourceFile = SrcFolderPath & SrcFileName & SrcFilExt

'Checking the Source File Existence
If FSO.FileExists(SourceFile) = False Then
WS.Cells(X, 6) = "Failed"
MsgBox ("Source File Does Not Exist or Path Not Found")
GoTo Nxt:
End If

'Source Folder Path
TargetFolderPath = WS.Cells(X, 5)

'Setting the Target Folder path end with "\"
If Right(TargetFolderPath, 1) <> "\" Then
        TargetFolderPath = TargetFolderPath & "\"
End If

'Checking the Target Folder Exists or Not
If FSO.FolderExists(TargetFolderPath) = False Then
WS.Cells(X, 6) = "Failed"
MsgBox ("Target Folder Does Not Exist or Path Not Found")
GoTo Nxt:
End If

'Copying the Files from Source location to Destination
FSO.CopyFile SourceFile, TargetFolderPath

'Changing the Source File Name in the Destination after Copy.
TgtFileName = TargetFolderPath & SrcFileName

Name TgtFileName & SrcFilExt As TgtFileName & " - " & WS.Cells(2, 7) & SrcFilExt
WS.Cells(X, 6) = "Success"

Nxt:

Next X

MsgBox "All Source Files SuccessFull Copied to Destination Folders", vbOKOnly, "Job Done"

Set WS = Nothing
Set FSO = Nothing

End Sub

Thanks,
TAMATAM


No comments:

Post a Comment

Follow Me by Email

ExcelKingdom-Popular Posts

ExcelKingdom-Random Posts