VBA find folders in unknown subfolder whitout searching all subfolders

[Ole Madsen]

My question is as follows:
in the code below I am searching for a directory named Range ("D3") = #
and Range ("B3") = 21000 to find folder # 21000
The folder is located in D: \ Documents \? \ # 21000

My problem is that I have a lot of folders in D: \ Document with many sub folders so it takes a really long time to search.
my code searches all folders and sub folders through
Is there a way it only searches for folders with # in front and stops when found.

My code looks like this.

Sub Gem_Certifikat()

Dim searchFolderName As String
searchFolderName = "D:\Document"

Dim FileSystem As Object

Set FileSystem = CreateObject("Scripting.FileSystemObject")

doFolder FileSystem.GetFolder(searchFolderName)

End Sub

Sub doFolder(Folder)
Dim subFolder
Dim Get_path
Dim strCheckPath As String
Dim PDFfile As Range
For Each subFolder In Folder.SubFolders
If Split(subFolder, "\")(UBound(Split(subFolder, "\"))) = Range("D3") & Range("B3") = True Then


Get_path = subFolder
strCheckPath = subFolder
strCheckPath = subFolder & "\Certifikat" & "\" & Range("B5") & "\"
If Len(Dir(strCheckPath, vbDirectory)) = 0 Then MkDir strCheckPath


For Each PDFfile In ActiveSheet.Range("B6")
If PDFfile.Value <> "" Then
FileCopy Range("B7") & PDFfile.Value, strCheckPath & PDFfile.Value
End If
Next

MsgBox "Certifikat Gemt"
End

End If

doFolder subFolder

Next subFolder

Exit Sub

End Sub

 

[John_w]

Welcome to MrExcel forums.

Instead of your recursive approach, which searches all levels of subfolders of "D:\Document", I would create an array containing the first-level subfolders in "D:\Document" (using FileSystemObject or the Dir function) and then use that array to look for the second-level subfolder named "# 21000".

 

[MMY]

Maybe youjust need to add "s" to "Document"

searchFolderName = "D:\Documents"

Sub Gem_Certifikat()

Dim searchFolderName As String
searchFolderName = "D:\Documents"

Dim FileSystem As Object

Set FileSystem = CreateObject("Scripting.FileSystemObject")

doFolder FileSystem.GetFolder(searchFolderName)

End Sub

Sub doFolder(Folder)
Dim subFolder
Dim Get_path
Dim strCheckPath As String
Dim PDFfile As Range
For Each subFolder In Folder.SubFolders
If Split(subFolder, "\")(UBound(Split(subFolder, "\"))) = Range("D3") & Range("B3") = True Then


Get_path = subFolder
strCheckPath = subFolder
strCheckPath = subFolder & "\Certifikat" & "\" & Range("B5") & "\"
If Len(Dir(strCheckPath, vbDirectory)) = 0 Then MkDir strCheckPath


For Each PDFfile In ActiveSheet.Range("B6")
If PDFfile.Value <> "" Then
FileCopy Range("B7") & PDFfile.Value, strCheckPath & PDFfile.Value
End If
Next

MsgBox "Certifikat Gemt"
End

End If

doFolder subFolder

Next subFolder

Exit Sub

End Sub