NorthbyNorthwest
Board Regular
- Joined
- Oct 27, 2013
- Messages
- 154
- Office Version
- 365
Hi, everyone. Trying to get code to copy multiple (about 20 workbooks) from folder with a great many subfolders. Code below stops after first folder is found and copied. Could you anyone tell why it does not continue to identify other files?
VBA Code:
Sub CopyFilesFromSubfolders()
Dim FSO As Object, fld As Object
Dim fsoFile As Object
Dim fsoFol As Object
sourcePath = "H:\QA\Monthly Quality Review\FY22 SQCRs\"
targetPath = "H:\QA\QA Management\FY2022 Audits and Reports\Monthly Combine\"
If Right(sourcePath, 1) <> "\" Then
sourcePath = sourcePath & "\"
End If
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 Right(fsoFile, 4) = "xlsm" Then
fsoFile.Copy targetPath
End If
Next
Next
End If
End Sub