Find folder path for string in cell

I'm on my work computer and I'm having a hard time replying with quote (sorry about that).

I tried to copy and paste that code outright and run it with the correct file path and I didn't get anything back in the cells.

I have another version of the code using FSOs and it suffers from the same problem (won't go into folders within folders).

Sub find_filepath()

Dim filepath As String
Dim i As Integer
Dim fso As Object
Dim fsofolder As Object
Dim subfolder As Object

Application.ScreenUpdating = False
Application.EnableCancelKey = xlErrorHandler

filepath = "C:\Users\name\directory 1\"

Set fso = CreateObject("Scripting.FileSystemObject")
Set fsofolder = fso.GetFolder(filepath)

On Error GoTo handle_cancel

For i = 2 To 25
    For Each subfolder In fsofolder.SubFolders
        If InStr(1, subfolder.Name, Range("C" & i).Value, 1) Then
            Range("D" & i).Value = subfolder.path
        End If
    Next subfolder
Next i

handle_cancel:
    If Err = 18 Then
        MsgBox "Cancelled."
    End If

End Sub

Can this be modified in any way to dig in deeper?

In column C is a list of (account) numbers, 3 digits, followed by a hyphen, followed by another 6 digits that would look like this:

000-000000

The folders I'm looking for would be named as follows:

000-000000 - Account Name

It would then be:

"C:\Users\name\directory 1\directory 2\000-000000 - Account Name"

I would like to look for the folder path containing the account number in column C and place that path in column D.

I get a run-time error (76): path not found.

It points to this line when debugging:

For Each fsoSubfolder In CreateObject("Scripting.FileSystemObject").GetFolder(strPath).SubFolders

I did. I'm still trying to play around with it. The path is on a network drive.

It seems like it's working fine when it's not on the network drive. I'll try and figure it out.

Thanks a lot!

I'll see if I can figure that out. Thanks again.

It's already the U:\ drive. It won't let me access it via your solution but using my earlier code with FSO works fine. I'm still hacking away at it.

I just tried that temporary mapping and it gave me the same error as last time (76, path not found).

Originally Posted by AlphaFrog

Both are using FSO (FileSystemObject). I don't know why one works and not the other.

Any other suggestions? The dir method seems to be the faster of the two that I've tried. Is there any way to have that skim through subfolders?

Originally Posted by AlphaFrog

Dir doesn't readily do subfolders. There's probably some code out there that has a workaround to make it work, but I don't know of it.

Why do you think Dir is faster? I've not experienced that.

If you got the first FSO to work with the network drive path, there's probably a way to get the code I suggested to work as well since they both use the came FSO functions. What did you do to get your original FSO code to work; details? Show what you did in both cases.

When I specified an exact folder in order to test the macro, the Dir macro finished the process several seconds quicker than FSO (shown below and as in post #3 of this thread) macro. Bear in mind this test was done on the network drive.

The exact code for the FSO method is (again) below and I can't really see why it would work, and your solution wouldn't. I used the exact same path that was in my code in yours and got an error. But when I tested yours on a test folder I made on the desktop, it worked beautifully.

Sub find_filepath()

Dim filepath As String
Dim i As Integer
Dim fso As Object
Dim fsofolder As Object
Dim subfolder As Object

Application.ScreenUpdating = False
Application.EnableCancelKey = xlErrorHandler

filepath = "C:\Users\name\directory 1\"

Set fso = CreateObject("Scripting.FileSystemObject")
Set fsofolder = fso.GetFolder(filepath)

On Error GoTo handle_cancel

For i = 2 To 25
    For Each subfolder In fsofolder.SubFolders
        If InStr(1, subfolder.Name, Range("C" & i).Value, 1) Then
            Range("D" & i).Value = subfolder.path
        End If
    Next subfolder
Next i

handle_cancel:
    If Err = 18 Then
        MsgBox "Cancelled."
    End If

End Sub

I'm back at work and I've tested your code by specifying the exact folder where to look (as I've done with my scripts) on the network drive and it worked fine so I think it's a bad folder on the network drive.

I added "On Error Resume Next" to the function and that fixed 'er right up.

Sub a_filepath2()
    
    Dim fpath As String
    Dim i As Long
    
    fpath = "U:\CMB\C0871\DEPTDATA\EAST\COMMERCIAL DOCS TOR K\GBM KYC TEAM\FATCA\FATCA-ACCENTURE\PHASE 3 - FUNDS\funds raj to review\"
    
    For i = 2 To 5
        Range("D" & i).Value = FindPath(fpath, Range("C" & i).Value)
    Next i
    
End Sub

Function FindPath(ByVal strPath As String, ByVal strMatch As String) As String
                  
    Dim fsosubfolder As Object
    
    FindPath = "N\A"  'Default value if file not found
    
    If Right(strPath, 1) <> "\" Then strPath = strPath & "\"
    
    On Error Resume Next
    If InStr(1, strPath, strMatch, 1) > 0 Then
        FindPath = strPath
    Else
        'Search sub folders
        For Each fsosubfolder In CreateObject("Scripting.FileSystemObject").GetFolder(strPath).SubFolders
            FindPath = FindPath(fsosubfolder.path, strMatch)
            If FindPath <> "N\A" Then Exit For
        Next fsosubfolder
    End If
    
End Function

Problem solved.

Thanks again!