How can I make macro loop through all levels of subfolders?

The macro in the attached spreadsheet searches through one level below the root folder. I need it to search through all levels of the root folder. The rest of the macro works fine. After it finds a match with a file name in column B, it moves the folder to a specified location. Thanks in advance.
Who is Participating?

[Product update] Infrastructure Analysis Tool is now available with Business Accounts.Learn More

I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

Ryan ChongBusiness Systems Analyst , ex-Senior Application EngineerCommented:
try customize this accordingly....

Public Const strFolder As String = "U:\TestFrom\"
Public Const strNewFolder As String = "U:\TestTo\"
Public cnt As Integer
Public Enum method
    Copy = 1
    Move = 2
End Enum

Sub Button1_Click()
    Call MoveFilesHybrid2
End Sub

Sub MoveFilesHybrid2()

    Dim objFSO As Object 'FileSystemObject
    Dim objFile As Object 'File
    Dim objFolder As Object 'Folder
    bContinue = True
    iRow = 2
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    Application.ScreenUpdating = False
    Do While Cells(iRow, "B") <> ""
        Filename = Cells(iRow, "B")
        cnt = 0
        For Each objFolder In objFSO.GetFolder(strFolder & "\").SubFolders
            Call loopFolder(objFSO, objFolder, Filename, Move)
        If cnt > 0 Then
            Cells(iRow, "C") = "On hand"
            Cells(iRow, "C").Font.Bold = False
            Cells(iRow, "C") = "Does not exist"
            Cells(iRow, "C").Font.Bold = True
        End If
        iRow = iRow + 1 ' INCREMENT ROW COUNTER.
    Application.ScreenUpdating = True
    MsgBox "Process executed" ' DONE.
End Sub

Sub loopFolder(ByRef objFSO As Object, ByVal objFolder As Object, ByVal Filename As String, m As method)
    Dim tPath As String
    tPath = Replace(objFolder.Path, strFolder, strNewFolder)
    If Dir(tPath & "\", vbDirectory) = "" Then
        MkDir tPath
    End If
    For Each objFile In objFolder.Files
        If InStr(1, objFile.Name, Filename, vbTextCompare) > 0 Then
            cnt = cnt + 1
            If Dir(tPath & "\" & objFile.Name) <> "" Then
                Kill tPath & "\" & objFile.Name
            End If
            If m = Copy Then
                objFSO.CopyFile objFile.Path, tPath & "\" & objFile.Name
                objFSO.MoveFile objFile.Path, tPath & "\" & objFile.Name
            End If
        End If
    For Each fldr In objFolder.SubFolders
        Call loopFolder(objFSO, fldr, Filename, m)
End Sub

Open in new window

I also make an option in the subroutine so that we can pass a parameter to choose whether to copy or move the files.

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
calyx_terenAuthor Commented:
It works perfectly! Thank you.
calyx_terenAuthor Commented:
Hey Ryan, it worked on my test folders, but once I updated the From and To folders with the actual folders, I got a Run Time Error 76 Path not found.

This are the lines I edited:
Public Const strFolder As String = "C:\Users\myfullname\Subfolder1\Partners-Folder\"
Public Const strNewFolder As String = "C:\Users\myfullname\Subfolder1\Archive\Partners-Archive\"

This is where I get the error:
MkDir tPath
Learn SQL Server Core 2016

This course will introduce you to SQL Server Core 2016, as well as teach you about SSMS, data tools, installation, server configuration, using Management Studio, and writing and executing queries.

Ryan ChongBusiness Systems Analyst , ex-Senior Application EngineerCommented:
1. are these directories exist?

>> "C:\Users\myfullname\Subfolder1\Partners-Folder\"
>> "C:\Users\myfullname\Subfolder1\Archive\Partners-Archive\"

2. do you have permission to access/create folders within these directories?

if you do a debug.print tPath before MkDir tPath, what would get? Would you able to create that folder manually (for testing?)
calyx_terenAuthor Commented:
Here is the information you need.
1. Yes, the directories exist
2. Yes, I have access/create permission in the directories

After I add the debug.Print tPath line, in the "To" folder Partners-Archive the macro creates the first folder in the "From" folder,  Partners-Folder, but it has no content
Ryan ChongBusiness Systems Analyst , ex-Senior Application EngineerCommented:
looks ok for me when I tested in my own environment.

Attached is the sample I working with.
calyx_terenAuthor Commented:
I'm still getting an error. The folder is sync'd to an online application. Could this be the problem?
Ryan ChongBusiness Systems Analyst , ex-Senior Application EngineerCommented:
>>The folder is sync'd to an online application
that could be the issue, what if you manually create one folder into that folder, will you getting any error?
calyx_terenAuthor Commented:
No, I don't get an error. I have access/create permissions in that folder.
Ryan ChongBusiness Systems Analyst , ex-Senior Application EngineerCommented:
can you copy or move any files to that manually created folder via VBA scripts?
calyx_terenAuthor Commented:
No, I haven't been able to copy or move files to the manually created folder via VBA scripts. I will continue to test.

I did notice that the first folder and all its subfolders were moved, but none of the files inside them were moved. The root folder is very large (>8 GB) and has several levels. Can it be a problem with the number of times the code loops through the folders?
calyx_terenAuthor Commented:
Ok. I tested with other folders that I created, and it worked. I have access/create permissions, but I think I need one level of permissions higher. I will investigate.
calyx_terenAuthor Commented:
I got the higher level of permissions, and the macro still did not move all files in all subfolders. It looked like it was only looping through one child folder, so i changed the path in the macro to that folder, and it worked. I'm changing it manually for every level 2 folder that I need it to loop through.
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Microsoft Excel

From novice to tech pro — start learning today.