VBA macro to copy files from one folder (and all it's subfolders, and their subfolders, and their subfolders....) to another folder?

[XL Addict]

Hi cool people,

I have been trying to make/find a VBA code to perform this task but no luck. Using FSO I was able to copy files form that folder and first layer of it's subfolders, but their subfolders and their subfolders were not reached. I have no idea on how to do this. Any hints? Also it would be good if I were able to copy files only with a certain extension (i.e. pdf, xlsx...).

Will appreciate any tip.

Cheers!

 

[XL Addict]

Thank you for the effort, I appreciate it. The code takes files only from the first level of subfolders it doesn't dig deeper. Is it possible to amend it to go "more in depth"? So through subfolders of the subfolders of the subfolders of the subfolders of the subfolders.... (the entire folder tree)
I will try to figure it out. Many thanks for the help!

Cheers man!

 

[GWteB]

The code takes files only from the first level of subfolders it doesn't dig deeper.

Sounds like a real mystery ...

Is it possible ...... through subfolders of the subfolders of the subfolders of the subfolders of the subfolders.... (the entire folder tree)

That's exactly what my code does!! Each directory found is treated as if it were the initial top-level directory because of this line of code:
Call CopyFiles_FromFolderAndSubFolders(argFileSpec, oFolder.Path, sPathDest)
in which the second procedure calls itself (the recursive part). For that reason two procedures were needed; one for specifying the (initial) source folder, the destination folder and the file specification (filename or string with wildcards) and the other for performing the desired actions. At the moment I cannot figure out why my code in your situation behaves as you described. In order to make it possible for you to see what the code actually does, I have made some additions (green lines) in the version below.

It's recommended to perform the following steps:
- paste both procedures together in a (separate) module
- change path and file specifications in the first procedure according to your requirements
- set a breakpoint on the red line of the second procedure (within VBE place cursor on line and press F9)
- open the Immidiate pane (press CTRL G)
- run the first procedure (place cursor within CopyFiles_DEBUG procedure and press F5)
and finally watch the immediate window to see what's going on. Code will pause at each folder, subfolder, subsubfolder (and so on ...) and code will resume by pressing F5.

Public Sub CopyFiles_DEBUG()

    Dim sPathSource As String, sPathDest As String, sFileSpec As String

    sPathSource = "C:\Users\Me\SourceFolder\"
    sPathDest = "Z:\DestinationFolderTree\SubFolder\EndpointFolder\"

    sFileSpec = "*.xlsx"
    'sFileSpec = "*example*2020.xl*"
    'sFileSpec = "*.pdf"

    Call CopyFiles_FromFolderAndSubFolders_DEBUG(sFileSpec, sPathSource, sPathDest)
End Sub

Public Sub CopyFiles_FromFolderAndSubFolders_DEBUG(ByVal argFileSpec As String, ByVal argSourcePath As String, ByRef argDestinationPath As String)

    Dim sPathSource As String, sPathDest As String, sFileSpec As String

    Dim FSO         As Object
    Dim oRoot       As Object
    Dim oFile       As Object
    Dim oFolder     As Object

    sPathSource = argSourcePath
    sPathDest = argDestinationPath

    If Not Right(sPathDest, 1) = "\" Then sPathDest = sPathDest & "\"
    If Right(sPathSource, 1) = "\" Then sPathSource = Left(sPathSource, Len(sPathSource) - 1)

    Set FSO = CreateObject("Scripting.FileSystemObject")

    If FSO.FolderExists(sPathSource) And FSO.FolderExists(sPathDest) Then
        Set oRoot = FSO.GetFolder(sPathSource)
Debug.Print "PROCESSING >> " & oRoot.Path
        For Each oFile In oRoot.Files
            If LCase(oFile.Name) Like argFileSpec Then
                On Error Resume Next
                oFile.Copy sPathDest & oFile.Name
If Err.Number = 0 Then
Debug.Print "COPIED : " & oFile.Name
Else
Debug.Print "error  : " & oFile.Name
End If
                On Error GoTo 0
Else
Debug.Print "skipped: " & oFile.Name
            End If
        Next oFile
        For Each oFolder In oRoot.SubFolders
            Call CopyFiles_FromFolderAndSubFolders_DEBUG(argFileSpec, oFolder.Path, sPathDest)
        Next oFolder
    End If
End Sub

 

[XL Addict]

I see... This is GREAT!!!
Million thanks!

 

[GWteB]

Glad it's sorted and thanks for letting me know.

 

[PrizeGotti]

You're welcome! The code below probably does what you had in mind. Recursion is the keyword, so two procedures are needed. Keep in mind that any duplicates will be overwritten, after all, all files end up in one and the same folder. Any duplicate file with a read-only file attribute will be skipped.

Public Sub CopyFiles_r2()

    Dim sPathSource As String, sPathDest As String, sFileSpec As String

    sPathSource = "C:\Users\Me\SourceFolder\"
    sPathDest = "Z:\DestinationFolderTree\SubFolder\EndpointFolder\"

    sFileSpec = "*.xlsx"
    'sFileSpec = "*example*2020.xl*"
    'sFileSpec = "*.pdf"

    Call CopyFiles_FromFolderAndSubFolders(sFileSpec, sPathSource, sPathDest)
End Sub


Public Sub CopyFiles_FromFolderAndSubFolders(ByVal argFileSpec As String, ByVal argSourcePath As String, ByRef argDestinationPath As String)

    Dim sPathSource As String, sPathDest As String, sFileSpec As String

    Dim FSO         As Object
    Dim oRoot       As Object
    Dim oFile       As Object
    Dim oFolder     As Object

    sPathSource = argSourcePath
    sPathDest = argDestinationPath

    If Not Right(sPathDest, 1) = "\" Then sPathDest = sPathDest & "\"
    If Right(sPathSource, 1) = "\" Then sPathSource = Left(sPathSource, Len(sPathSource) - 1)

    Set FSO = CreateObject("Scripting.FileSystemObject")

    If FSO.FolderExists(sPathSource) And FSO.FolderExists(sPathDest) Then
        Set oRoot = FSO.GetFolder(sPathSource)
        For Each oFile In oRoot.Files
            If LCase(oFile.Name) Like argFileSpec Then
                On Error Resume Next
                oFile.Copy sPathDest & oFile.Name
                On Error GoTo 0
            End If
        Next oFile
        For Each oFolder In oRoot.SubFolders
            ' == do the same for any folder ==
            Call CopyFiles_FromFolderAndSubFolders(argFileSpec, oFolder.Path, sPathDest)
        Next oFolder
    End If
End Sub

I am confused as to why you took the approach to create a completely different macro when you could of changed this line in the original macro;

sPathSource = "C:\SourceFolder\*.*"

To

sPathSource = "C:\SourceFolder\*.fileextension" 'change "fileextension" to the required file type.

Am I missing something?

 

[GWteB]

I am confused as to why you took the approach to create a completely different macro when you could of changed this line in the original macro;

@PrizeGotti, not sure which "original macro" you're referring to, but if a file specification including wildcards is prefixed with a full path rather being just a specification without a path (like e.g. example*20??.xl*), the code's result in the line below will never be a match and there will be no copying at all since oFile.Name does not contain a path.
So yes, you were missing something...

If LCase(oFile.Name) Like argFileSpec Then