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

目前，我正在使用VBAmacros来收集主文件夹中所有子文件夹的名称，并将它们写入工作表。 目前的方法是使用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命令基本上没有足够快地创build文本文件，这造成了一团糟。 此macros被设置为打开工作簿时运行，因此它是相当重要的。 我目前通过join来解决这个问题

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

shell命令运行后，但这个解决scheme对我来说太不雅了。 我很好奇，是否有一种方法可以用来消除创build和读取文本文件的需要。 我可以直接获取文件夹内容的列表吗？

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 

编辑：你应该删除临时文件，然后创build一个新的。 否则第二次运行代码时会出现同样的问题。

Answer 3

使用shell和Dir是1990年代的一个版本：P

FileSystemObject是更多的OOP'y。 我想你的首选。

下面允许您指定recursion的深度（0表示指定文件夹的子文件夹，0表示指定深度的子文件夹（例如，1表示所有子文件夹的子文件夹），<0表示通过目录树完全recursion）。

 '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