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

目前，我使用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命令运行之后，但是这个解决方案对我来说太不雅观了。我很好奇是否有一种方法可以让我不用创建然后读取文本文件。我可以直接获取文件夹内容列表吗？

是的，您可以通过编程方式（

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

Dim lookin作为字符串，directory作为字符串，j作为长
lookin=“c:\windows\”
directory=Dir$（lookin&“***”，vbDirectory）
j=1
Do While Len（目录）
如果目录“.”和目录“.”以及GetAttr（lookin&directory）和vbDirectory，则
MAIN.Cells（j，1）.Value=目录
j=j+1
如果结束
directory=Dir$（）
环

您可以检查文件是否存在，如下所示

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

---

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

使用shell和Dir有点像1990年的imo:p

FileSystemObject的面向对象性更强。我想是你的首选吧

---

下面允许您指定递归的深度（仅指定文件夹的子文件夹为0，指定子文件夹的深度大于0（例如，所有子文件夹的子文件夹为1），这非常好；几乎可以立即工作。非常感谢。我刚刚注意到：if函数是否应该包含GetAttr（lookin&directory）=vbDirectory，而不是“And”？

GetAttr

返回一个位掩码-即一组掩码标志

或
'd一起返回，例如（
vbarchive或vbhidden
），因此您使用
和
（按位而非逻辑）确定是否存在标志。技术上正确的答案为+1。然而，尽管这解决了眼前的问题，但我认为这仍然为OP的根本缺陷方法提供了一个石膏
'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