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.
Test-File-Move-Macro0.xlsm
calyx_terenAsked:
Who is Participating?
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 ChongCommented:
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)
        Next
        If cnt > 0 Then
            Cells(iRow, "C") = "On hand"
            Cells(iRow, "C").Font.Bold = False
        Else
            Cells(iRow, "C") = "Does not exist"
            Cells(iRow, "C").Font.Bold = True
        End If
        iRow = iRow + 1 ' INCREMENT ROW COUNTER.
    Loop
    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
            Else
                objFSO.MoveFile objFile.Path, tPath & "\" & objFile.Name
            End If
        End If
    Next
    
    For Each fldr In objFolder.SubFolders
        Call loopFolder(objFSO, fldr, Filename, m)
    Next
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.
0

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.
0
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
0
Upgrade your Question Security!

Your question, your audience. Choose who sees your identity—and your question—with question security.

Ryan ChongCommented:
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?)
0
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
0
Ryan ChongCommented:
looks ok for me when I tested in my own environment.

Attached is the sample I working with.
Test-File-Move-Macro0_b.xlsm
0
calyx_terenAuthor Commented:
I'm still getting an error. The folder is sync'd to an online application. Could this be the problem?
0
Ryan ChongCommented:
>>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?
0
calyx_terenAuthor Commented:
No, I don't get an error. I have access/create permissions in that folder.
0
Ryan ChongCommented:
can you copy or move any files to that manually created folder via VBA scripts?
0
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?
0
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.
0
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.
0
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.

Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.