Currently I am employing a VBA macro that is meant to collect the names of all the subfolders within a main folder and write them into a worksheet. The current method is to use the Shell command to open cmd.exe and write the list to a text file. The file is then subsequently opened and read into the worksheet:
Sub Button_GetList() Dim RunCommand As String, FolderListPath As String, _ TempFile As String, MainFolder As String TempFile = "foldernames.txt" MainFolder = "simulations" RunCommand = _ "cmd.exe /c dir " & ThisWorkbook.Path & "\" & MainFolder & " /b > " _ ThisWorkbook.Path & "\" & TempFile x = Shell(RunCommand, 1) FolderListPath = ThisWorkbook.Path & "\" & TempFile Close #1 Open FolderListPath For Input As #1 j = 1 Do While Not EOF(1) Line Input #1, TextLine MAIN.Cells(j, 1) = TextLine j = j + 1 Loop Close #1 End Sub
The main problem is that the shell command basically isn’t creating the text file fast enough before the next function attempts to open it, which causes a mess. This macro is set to run when the workbook is opened so it’s fairly critical. I have currently countered the problem by adding
Application.Wait (Now + TimeValue("0:00:05"))
after the shell command runs, but this solution is too inelegant for me to stomach. I am curious whether there is a method that I could employ that would eliminate the need to create and then read a text file. Can I get a list of a folder’s contents directly?
Yep, you can fetch the list programmatically (
Dir$()) rather that by running an external process;
Dim lookin As String, directory As String, j As Long lookin = "c:\windows\" directory = Dir$(lookin & "*.*", vbDirectory) j = 1 Do While Len(directory) If directory <> "." And directory <> ".." And GetAttr(lookin & directory) And vbDirectory Then MAIN.Cells(j, 1).Value = directory j = j + 1 End If directory = Dir$() Loop
you could check if the file exists, like this
x = Shell(RunCommand, 1) 'your code Do DoEvents Loop until Not Dir(ThisWorkbook.Path & "\" & TempFile) = "" FolderListPath = ThisWorkbook.Path & "\" & TempFile Close #1 'your code Open FolderListPath For Input As #1
edit: you should delete the tempfile before creating a new one. otherwise you will have the same problem the second time you run your code.
Using shell and Dir is a bit 1990’s imo 😛
FileSystemObject is a lot more OOP’y. Take your preferred choice I suppose.
The below allows you to specify the depth of recursion (0 for just the specified folder’s subfolders, >0 for the specified depth of subfolders (e.g. 1 for all subfolders’ subfolders) and <0 for fully recursing through the directory tree).
'recursionDepth = 0 for no recursion, >0 for specified recursion depth, <0 for unlimited recursion Private Sub getSubdirectories(parent, subdirectoriesC As Collection, Optional recursionDepth As Integer = 0) Dim subfolder For Each subfolder In parent.subfolders subdirectoriesC.Add subfolder If recursionDepth < 0 Then getSubdirectories subfolder, subdirectoriesC, recursionDepth ElseIf recursionDepth > 0 Then getSubdirectories subfolder, subdirectoriesC, recursionDepth - 1 End If Next subfolder End Sub
The below is just an example usage
Sub ExampleCallOfGetSubDirectories() Dim parentFolder, subdirectoriesC As Collection, arr, i As Long Set parentFolder = CreateObject("Scripting.FileSystemObject").GetFolder("your folder path") Set subdirectoriesC = New Collection getSubdirectories parentFolder, subdirectoriesC, 0 'This section is unnecessary depending on your uses 'For this example it just prints the results to the Activesheet If subdirectoriesC.Count > 0 Then ReDim arr(1 To subdirectoriesC.Count, 1 To 1) For i = 1 To UBound(arr, 1) arr(i, 1) = subdirectoriesC(i).Path Next i With ActiveSheet .Range(.Cells(1, 1), .Cells(subdirectoriesC.Count, 1)).Value = arr End With End If End Sub