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!

 

[GWteB]

Using Excel on Windows this code works for me.

Sub CopyFiles()

    Dim sPathSource As String, sPathDest As String, sConsoleCmd As String
    
    sPathSource = "C:\SourceFolder\*.*"
'    sPathSource = "C:\SourceFolder\*.pdf"
'    sPathSource = "C:\SourceFolder\*.xls?"
    sPathDest = "Z:\DestinationFolderTree\SomeFolder\EndpointFolder"
    
    If Not Right(sPathDest, 1) = "\" Then sPathDest = sPathDest & "\"
    sConsoleCmd = "cmd.exe /c xcopy " & sPathSource & " " & sPathDest & " /s/i/y/r/k"
    Shell sConsoleCmd, 6    ' << change 6 into 1 to see what's going on
End Sub

 

[XL Addict]

Hi WEteB,

I tried using this code (on Win 10), with Office 365 but not working somehow. The code did ran, but no result. No errors reported, but also no files have been copied.
What might be the problem?

 

[GWteB]

The code is pretty straightforward and has no check on the result. The code uses the Windows console to run the Windows utility xcopy.exe located on disk in C:\Windows\system32\ (on 64bit Windows strictly spoken located in C:\Windows\WinSxS\ but not visible for the user so forget about that...).
There can be several reasons for the result you have experienced:
- the source folder does not exist;
- the file specification (with or without wildcards) is invalid;
- the destination folder does not exist or could not been made because of a wrong or non existing path.

Check the spelling of your path names and replace these two lines

    sConsoleCmd = "cmd.exe /c xcopy " & sPathSource & " " & sPathDest & " /s/i/y/r/k"
    Shell sConsoleCmd, 6    ' << change 6 into 1 to see what's going on

with

    sConsoleCmd = "cmd.exe /k xcopy " & sPathSource & " " & sPathDest & " /s/i/y/r/k"
    Shell sConsoleCmd, 1    ' << change 6 into 1 to see what's going on

The console window will be visible on screen so progress can be watched and messages can be read. Once xcopy has finished, the console window will remain open to examine the results.

 

[XL Addict]

The console reports "Invalid number of parameters". What might this be?

 

[GWteB]

I prefer not to use spaces in folder names, but the option to use them does actually exist. Of course I should have taken that into account.
Please change

    sConsoleCmd = "cmd.exe /c xcopy " & sPathSource & " " & sPathDest & " /s/i/y/r/k"

to

    sConsoleCmd = "cmd.exe /k xcopy " & """" & sPathSource & """" & " " & """" & sPathDest & """" & " /s/i/y/r/k"

 

[XL Addict]

This made the code work on my PC. But it copied the entire content of the source folder - all folders with their subfolders. I was trying to find a way to extract the files (.pdf in this case) and copy only them not the folders they were in. Is this possible?

 

[GWteB]

Apparently I misunderstood your original request. For sure this is possible but requires a completely different approach so let me think about this for a while ...

 

[XL Addict]

No worries man. Thank you for your effort. I have been making some results with FileSystemObject (FSO). But didn't quite make it work.

Using VBA FileSystemObject (FSO) in Excel - Examples

In this tutorial, I will show you how to use VBA FileSystemObject (FSO) to work with files and folders on your system or network drives.

trumpexcel.com

 

[GWteB]

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