Copy Files from One Location to Another folder or directory in Excel VBA

mrlionsss

New Member
Joined
Nov 11, 2020
Messages
8
Office Version
  1. 2007
Platform
  1. Windows
I have the following code which copies an Excel file from one destination to another.

VBA Code:
Sub sbCopyingAFile()

Dim FSO
Dim sFile As String
Dim sSFolder As String
Dim sDFolder As String

'This is a File Name which I want to Copy
sFile = "report 1.2.2020_updated.xlsm"

'Source folder path
sSFolder = "C:\Users\Admin\Documents\report\2020\"

'Destination folder path
sDFolder = "C:\Users\Admin\Documents\files\Client1\"

'Create Object
Set FSO = CreateObject("Scripting.FileSystemObject")

'Checking If File Is Located in the Source Folder
If Not FSO.FileExists(sSFolder & sFile) Then
    MsgBox "Specified File Not Found", vbInformation, "Not Found"
   
'Copying If the Same File is Not Located in the Destination Folder
ElseIf Not FSO.FileExists(sDFolder & sFile) Then
    FSO.CopyFile (sSFolder & sFile), sDFolder, True
    MsgBox "Specified File Copied Successfully", vbInformation, "Done!"
Else
    MsgBox "Specified File Already Exists In The Destination Folder", vbExclamation, "File Already Exists"
End If
End Sub

The destination folder is fixed now and the code works great, but i actually have a hundreds of these destination folders that i need the file copied to. I have a list of the folder names in the column A, beginning with A1 (e.g. Client1, Client2, Client3...). The path before that is always the same - C:\Users\Admin\Documents\files\

Is it possible that the macro goes through the list and copies and pastes the file in the corresponding folders listed?

Tried this on my own, but i'm not sure how to loop this.

Any help is appreciated!
 

Some videos you may like

Excel Facts

Format cells as currency
Select range and press Ctrl+Shift+4 to format cells as currency. (Shift 4 is the $ sign).

NdNoviceHlp

Well-known Member
Joined
Nov 9, 2002
Messages
2,670
Maybe something like this...
Code:
Sub test()
Dim Lastrow As Integer, Cnt As Integer
With Sheets("Sheet1")
Lastrow = .Range("A" & .Rows.Count).End(xlUp).Row
For Cnt = 1 To Lastrow
Call sbCopyingAFile(CStr(.Range("A" & Cnt).Value))
Next Cnt
End With
End Sub


Function sbCopyingAFile(ClientName As String)

Dim FSO
Dim sFile As String
Dim sSFolder As String
Dim sDFolder As String

'This is a File Name which I want to Copy
sFile = "report 1.2.2020_updated.xlsm"

'Source folder path
sSFolder = "C:\Users\Admin\Documents\report\2020\"

'Destination folder path
'sDFolder = "C:\Users\Admin\Documents\files\Client1\"
sDFolder = "C:\Users\Admin\Documents\files\" & ClientName & "\"

'Create Object
Set FSO = CreateObject("Scripting.FileSystemObject")

'Checking If File Is Located in the Source Folder
If Not FSO.FileExists(sSFolder & sFile) Then
    MsgBox "Specified File Not Found", vbInformation, "Not Found"
  
'Copying If the Same File is Not Located in the Destination Folder
ElseIf Not FSO.FileExists(sDFolder & sFile) Then
    FSO.CopyFile (sSFolder & sFile), sDFolder, True
    MsgBox "Specified File Copied Successfully", vbInformation, "Done!"
Else
    MsgBox "Specified File Already Exists In The Destination Folder", vbExclamation, "File Already Exists"
End If
End Function
HTH. Dave
ps. I'm guessing U may want to alter/delete your msgboxes
 
Solution

mrlionsss

New Member
Joined
Nov 11, 2020
Messages
8
Office Version
  1. 2007
Platform
  1. Windows
Nice! Thanks a lot!

Yeah, the msgboxes will go, once it's running.
 

Watch MrExcel Video

Forum statistics

Threads
1,118,800
Messages
5,574,404
Members
412,590
Latest member
Velly
Top