Question

目前我正在使用一个VBA宏，用于收集主文件夹中所有子文件夹的名称，并将它们写入工作表。当前方法是使用Shell命令打开cmd.exe并将列表写入文本文件。随后打开该文件并将其读入工作表：

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

主要问题是shell命令基本上没有在下一个函数尝试打开它之前足够快地创建文本文件，这会导致混乱。此宏设置为在打开工作簿时运行，因此它非常关键。我目前通过添加

来解决这个问题

Application.Wait (Now + TimeValue("0:00:05"))

shell命令运行后

，但这个解决方案对我来说太不优雅了。我很好奇是否有一种方法可以消除创建然后读取文本文件的需要。我可以直接获得文件夹内容列表吗？

Answer 1

是的，您可以通过编程方式（Dir$()）获取列表，而不是通过运行外部流程;

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

Answer 2

您可以检查文件是否存在，例如

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

编辑：您应该在创建新文件之前删除它。否则在第二次运行代码时会出现同样的问题。

Answer 3

使用shell和Dir有点1990年的imo：P

FileSystemObject更多OOP'y。我想你最喜欢的选择。

下面允许您指定递归的深度（仅指定文件夹的子文件夹为0，指定的子文件夹深度为> 0（例如，所有子文件夹的子文件夹为1），＆lt; 0表示完全递归目录树）。

'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

以下只是一个示例用法

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

VBA - 将文件夹内容写入工作表

3 个答案: