CODEWITHSUNDEEP
vbaexcel
teepee
teepee

Reputation: 2714

VBA - writing folder contents to worksheet

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?

Upvotes: 1

Views: 1095

Answers (3)

Cor_Blimey
Cor_Blimey

Reputation: 3310

Using shell and Dir is a bit 1990's imo :P

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

Upvotes: 1

eventHandler
eventHandler

Reputation: 1211

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.

Upvotes: 1

Alex K.
Alex K.

Reputation: 175956

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

Upvotes: 1

Related Questions