Assign variable for fixed path to FSO to scan folder and subfolders - excel

Question

I have created an excel macro, which loops through the different subfolders of a fixed parent folder. The parent folder directory does not change. I have found a code on the net, which first lets me choose the folder to scan, which is nice, but is awkward for my purpose, since I run the code several times and each time I have to choose the folder again.
Instead I would like to give the macro the fixed full path and do without the prompt to choose the folder. I have written the following code, but do not know how to adjust it to make it work the way I described. Could you give me some advise?
This is the code:
Dim MyPath As String, MyFolderName As String, MyFileName As String, strStartCell2 As String, strFolderToScan As String
Dim i As Integer
Dim F As Boolean
Dim objShell As Object, objFolder As Object, AllFolders As Object, AllFiles As Object, strFileFormat As Object, fso As Object
Dim MySheet As Worksheet
'Define variables and constants
Set strFileFormat = ThisWorkbook.Worksheets("Makro").Range("A6")
strStartCell2 = strStartCell
strFolderToScan = ThisWorkbook.Worksheets("Makro").Range("C4").Value & "\"
'Select folder
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.BrowseForFolder(0, "Please select the folder you would like to scan", 0, 0)
If Not objFolder Is Nothing Then
MyPath = objFolder.self.Path & "\"
ThisWorkbook.Worksheets("Sheet1").Range("B3").Value = MyPath
Else
Exit Sub
End If
Set objFolder = Nothing
Set objShell = Nothing
'List all folders
Set AllFolders = CreateObject("Scripting.Dictionary")
Set AllFiles = CreateObject("Scripting.Dictionary")
AllFolders.Add (MyPath), ""
i = 0
Do While i < AllFolders.Count
Key = AllFolders.keys
MyFolderName = Dir(Key(i), vbDirectory)
Do While MyFolderName <> ""
If MyFolderName <> "." And MyFolderName <> ".." Then
If (GetAttr(Key(i) & MyFolderName) And vbDirectory) = vbDirectory Then
AllFolders.Add (Key(i) & MyFolderName & "\"), ""
End If
End If
MyFolderName = Dir
Loop
i = i + 1
Loop
'List all files
For Each Key In AllFolders.keys
MyFileName = Dir(Key & "*." & strFileFormat)
Do While MyFileName <> ""
AllFiles.Add (Key & MyFileName), ""
MyFileName = Dir
Loop
Next
'List all files in Files sheet
Sheets("Makro").Range(strStartCell2).Resize(AllFiles.Count, 1) = WorksheetFunction.Transpose(AllFiles.keys)
Set AllFolders = Nothing
Set AllFiles = Nothing
Probably this is simple, but i just can't figure out how to do it.
Thanks a lot in advance!
Oliver

Answer 1

This is the relevant part for selecting the folder
'Select folder
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.BrowseForFolder(0, "Please select the folder you would like to scan", 0, 0)
If Not objFolder Is Nothing Then
MyPath = objFolder.self.Path & "\"
ThisWorkbook.Worksheets("Sheet1").Range("B3").Value = MyPath
Else
Exit Sub
End If
Set objFolder = Nothing
Set objShell = Nothing
Especially the objShell.BrowseForFolder is the part that asks you to browse for the folder. So you need to replace that to use strFolderToScan directly. We do that by using objShell.GetFolder(strFolderToScan) to get the folder from your path strFolderToScan.
But I recommend to check if the folder actually exists, so you do not run into errors:
'Select folder
Set objShell = CreateObject("Shell.Application")
If objShell.FolderExists(strFolderToScan) Then
MyPath = strFolderToScan
ThisWorkbook.Worksheets("Sheet1").Range("B3").Value = MyPath
Else
MsgBox "The folder '" & strFolderToScan & "' does not exist."
Exit Sub
End If
Set objShell = Nothing