Copy specific files from Folder and sub-folder

howard

Well-known Member
Joined
Jun 26, 2006
Messages
6,561
Office Version
  1. 2021
Platform
  1. Windows
I have code below to copy files from a folder and sub-folder (these are on a network) where the name contains "*Template*2020.xlsm*"

When running the code I get get a run time error "object Required" and the code below is highlighted
Code:
 Set FSO = CreateObject(“Scripting.FileSystemObject”)


It would be appreciated if someone could kindly amend my code



See full code below :

Code:
 Sub copy_files_from_subfolders()

 Dim FSO As Object, fld As Object

 Dim fsoFile As Object

 Dim fsoFol As Object



SourcePath = "abt\Sales\"

targetPath = "C:\Sales Reports\"



If Right(SourcePath, 1) <> " \" Then SourcePath = SourcePath & " \"



Set FSO = CreateObject(“Scripting.FileSystemObject”)

Set fld = FSO.GetFolder(SourcePath)

 If FSO.FolderExists(fld) Then

 For Each fsoFol In FSO.GetFolder(SourcePath).SubFolders

 For Each fsoFile In fsoFol.Files

 If fsoFile = "*Template*2020.xlsm*" Then

 fsoFile.Copy targetPath

 End If

 Next

 Next

 End If 
End Sub


End Sub
 

Excel Facts

Using Function Arguments with nested formulas
If writing INDEX in Func. Arguments, type MATCH(. Use the mouse to click inside MATCH in the formula bar. Dialog switches to MATCH.
Instead of
Rich (BB code):
Set FSO = CreateObject(Scripting.FileSystemObject)

use
Rich (BB code):
Set FSO = CreateObject("Scripting.FileSystemObject")


It one of those annoyingly difficult things to spot - the wrong quote marks o_O

The formula to get the character number of the first character in a cell is ...
=CODE(A1)

Try pasting both quote marks, one into cell A1 and the other into cell A2 and you will discover that the formula returns 34 for the one that works and 147 for the other
 
Last edited:
Upvote 0
thanks for spotting this

I have corrected the quotation marks

I now get a run time error "Path not found' and the code below is highlighted


Code:
  For Each fsoFol In FSO.GetFolder(SourcePath).SubFolders



Code:
 Sub copy_files_from_subfolders()
Dim FSO As Object, fld As Object
Dim fsoFile As Object
 Dim fsoFol As Object

SourcePath = "\\abt\sales\"
targetPath = "C:\sales Reports\"

If Right(SourcePath, 1) <> " \" Then SourcePath = SourcePath & " \"

Set FSO = CreateObject("Scripting.FileSystemObject")
Set fld = FSO.GetFolder(SourcePath)
If FSO.FolderExists(fld) Then
For Each fsoFol In FSO.GetFolder(SourcePath).SubFolders
For Each fsoFile In fsoFol.Files
If fsoFile = "*Template*2020.xlsm*" Then
fsoFile.Copy targetPath
End If
Next
Next
 End If

End Sub


Kindly check and amend my code
 
Upvote 0
Try this

Amend this line
Rich (BB code):
SourcePath = "\\abt\sales\"
SourcePath = "\\abt\sales"

delete this line
Rich (BB code):
If Right(SourcePath, 1) <> " \" Then SourcePath = SourcePath & " \"
 
Upvote 0
Thanks for the help

the macro run now without any errors, but no files copied to "C:\sales Reports\" fov eg BR1 Templates sales 2020.xlsm, BR2 Templates2020.xlsm


Please check and amend file name if necessary
 
Upvote 0
Rich (BB code):
If fsoFile = "*Template*2020.xlsm*" Then
fsoFile.Copy targetPath
End If

VBA Code:
If LCase(fsoFile.Name) Like "*template*2020.xlsm*" Then
   fsoFile.Copy targetPath & fsoFile.Name
End If

NOTE
target path must end with path separator (as in your original code)
Rich (BB code):
targetPath = "C:\sales Reports\"
 
Upvote 0
Many Thanks for all the help. Code works perfectly
 
Upvote 0

Forum statistics

Threads
1,213,546
Messages
6,114,256
Members
448,557
Latest member
richa mishra

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top