copying files from multiple subfolders using vba - excel

Question

I've seen some documentation on this but so far, nothing that I've been able to replicate for my specific project.
My code points at a directory that contains 60 or so subfolders. Within these subfolders are multiple files .PDF/.XLS etc. The following code works fine if the files are not embedded in the subfolders but what I need to do is be able to loop through the subfolders and pull the files themselves to move. Also, is there a way to eventually pull files by wildcard name? Thanks in advance for any help.
Dim FSO As Object
Dim FromPath As String
Dim ToPath As String
Dim Fdate As Date
Dim FileInFromFolder As Object
FromPath = "H:\testfrom\"
ToPath = "H:\testto\"
Set FSO = CreateObject("scripting.filesystemobject")
For Each FileInFromFolder In FSO.getfolder(FromPath).Files
Fdate = Int(FileInFromFolder.DateLastModified)
If Fdate >= Date - 1 Then
FileInFromFolder.Copy ToPath
End If
Next FileInFromFolder
End Sub

Answer 1

You can also use recursion. Your folder can have subfolders having subfolders having ...
Public Sub PerformCopy()
CopyFiles "H:\testfrom\", "H:\testto\"
End Sub
Public Sub CopyFiles(ByVal strPath As String, ByVal strTarget As String)
Set FSO = CreateObject("scripting.filesystemobject")
'First loop through files
For Each FileInFromFolder In FSO.getfolder(strPath).Files
Fdate = Int(FileInFromFolder.DateLastModified)
If Fdate >= Date - 1 Then
FileInFromFolder.Copy strTarget
End If
Next FileInFromFolder
'Next loop throug folders
For Each FolderInFromFolder In FSO.getfolder(strPath).SubFolders
CopyFiles FolderInFromFolder.Path, strTarget
Next FolderInFromFolder
End Sub

Answer 2

I managed to get this code to work. It copies all folders / files and sub folders and their files to the new destination (strTarget).
I have not added checks and balances like 1) if the files and folders exist already. 2) if the source files are open etc. So those additions could be useful.
I got this code from Barry's post but needed to change it to make it work for me, so thought i'd share it again anyway.
Hope this is useful though. . .
strPath is the source path and strTarget is the destination path. both paths should end in '\'
Note: one needs to add "Microsoft Scripting Runtime" under "Tools / References" for FSO to work.
==================== call ================================
MkDir "DestinationPath"
CopyFiles "SourcePath" & "\", "DestinationPath" & "\"
==================== Copy sub ===========================
Public Sub CopyFiles(ByVal strPath As String, ByVal strTarget As String)
Dim FSO As Object
Dim FileInFromFolder As Object
Dim FolderInFromFolder As Object
Dim Fdate As Long
Dim intSubFolderStartPos As Long
Dim strFolderName As String
Set FSO = CreateObject("scripting.filesystemobject")
'First loop through files
For Each FileInFromFolder In FSO.GetFolder(strPath).Files
Fdate = Int(FileInFromFolder.DateLastModified)
'If Fdate >= Date - 1 Then
FileInFromFolder.Copy strTarget
'end if
Next
'Next loop throug folders
For Each FolderInFromFolder In FSO.GetFolder(strPath).SubFolders
'intSubFolderStartPos = InStr(1, FolderInFromFolder.Path, strPath)
'If intSubFolderStartPos = 1 Then
strFolderName = Right(FolderInFromFolder.Path, Len(FolderInFromFolder.Path) - Len(strPath))
MkDir strTarget & "\" & strFolderName
CopyFiles FolderInFromFolder.Path & "\", strTarget & "\" & strFolderName & "\"
Next 'Folder
End Sub

Answer 3

I found the solution here:
Private Sub Command3_Click()
Dim objFSO As Object 'FileSystemObject
Dim objFile As Object 'File
Dim objFolder As Object 'Folder
Const strFolder As String = "H:\testfrom2\"
Const strNewFolder As String = "H:\testto\"
Set objFSO = CreateObject("Scripting.FileSystemObject")
For Each objFolder In objFSO.GetFolder(strFolder & "\").SubFolders
'If Right(objFolder.Name, 2) = "tb" Then
For Each objFile In objFolder.Files
'If InStr(1, objFile.Type, "Excel", vbTextCompare) Then
On Error Resume Next
Kill strNewFolder & "\" & objFile.Name
Err.Clear: On Error GoTo 0
Name objFile.Path As strNewFolder & "\" & objFile.Name
'End If
Next objFile
'End If
Next objFolder
End Sub