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
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
Hi User, Thank You for visiting My Blog. Please post your genuine Feedback or comments only related to this Blog Posts. Please do not post any Spam comments or Advertising kind of comments which will be Ignored.