Modify your function to just test the current folder:
Function FindFolder(CurrentDirectory As Scripting.Folder, FolderName As String) As Scripting.Folder
On Error GoTo errHandler
If CurrentDirectory .Name = FolderName Then _
Set FindFolder = CurrentDirectory : Exit Function
Set FindFolder = Nothing
Dim fold As Scripting.Folder
If CurrentDirectory.SubFolders.Count > 0 Then
For Each fold In CurrentDirectory.SubFolders
Debug.Print fold.Path
Set FindFolder = FindFolder(fold, FolderName)
If not(FindFolder Is Nothing) Then
Exit For ' this one
End If
Next fold
End If