Vba 宏列出文件夹和子文件夹中的所有工作表

我一直在尝试编写一些代码，深入目录中的每个文件夹和子文件夹，列出我的工作簿中工作表的名称。经过很多时间和帮助，从这个论坛上的帖子，我已经到了这一步，但仍然没有一个工作的宏。我相信这是显而易见的，我为这场戈尔事件道歉，但有人知道为什么它不起作用吗？谢谢

Option Explicit

Sub marines()
    Dim FileSystem As Object
    Dim HostFolder As String
    Dim OutputRow
    OutputRow = 2
    HostFolder = "G:\EP\Projects\"
    Set FileSystem = CreateObject("Scripting.FileSystemObject")
    DoFolder FileSystem.GetFolder(HostFolder)
End Sub


Sub DoFolder(Folder)
    Dim SubFolder
    Dim Workbook As Variant
    Dim wb As Workbook
        Dim ws As Worksheet
    Dim HostFolder
    Dim OutputRow
       OutputRow = 2
       FileType = "*.xls*"
    For Each SubFolder In Folder.SubFolders
        DoFolder SubFolder
    Next
    For Each Workbook In Folder.SubFolders
    ThisWorkbook.ActiveSheet.Range("A" & OutputRow).Activate
        OutputRow = OutputRow + 1
        Curr_File = Dir(HostFolder & FileType)
        Do Until Curr_File = ""
        For wb = wb.Open(HostFolder & Curr_File, False, True)
                ThisWorkbook.ActiveSheet.Range("A" & OutputRow) =     ThisWorkbook.Name
            ThisWorkbook.ActiveSheet.Range("B" & OutputRow).ClearContents
            OutputRow = OutputRow + 1

        Set Each ws In wb.Sheets
                ThisWorkbook.ActiveSheet.Range("B" & OutputRow) = ws.Name
                ThisWorkbook.ActiveSheet.Range("A" & OutputRow).ClearContents
                OutputRow = OutputRow + 1
            Next ws
            wb.Close SaveChanges:=False
    Next
End Sub

---

我知道你提到了Microsoft脚本运行时，所以我将跳过这一部分

简单解决方案：一个模块，用于递归提取文件夹和子文件夹中的所有工作簿，并将其添加到集合中：

Public Sub ExtractAllWorkbooks(ByVal Addr As String, ByRef coll As Collection)
    DoEvents
    Dim objFSO As New FileSystemObject
    Dim objFile As File, objFolder As Folder, objSubFolder As Folder

    Set objFolder = objFSO.GetFolder(Addr)

    For Each objFile In objFolder.Files
        If Right(objFile.Name, 5) = ".xlsx" And Left(objFile.Name, 1) <> "~" Then
            Call addStringToCollection(objFile.Path, coll)
        End If
    Next

    For Each objSubFolder In objFolder.SubFolders
        Call ExtractAllWorkbooks(objSubFolder.Path, coll)
    Next
End Function


Public Sub addStringToCollection(stringToAdd As String, coll As Collection)
    Dim st As String
    For i = 1 To coll.Count
        st = coll.Item(i)
        If st = stringToAdd Then Exit Sub
    Next
coll.Add stringToAdd
End Sub

现在，您应该已经在集合Coll中列出了所有工作簿。只要打开它们，把工作表的名字撤到别处。假设您正在将结果导出到工作表wsRef，类似这样的操作应该可以实现：

dim wb as Workbook, ws as Worksheet
i = 2
For each st in coll
    Set wb = Workbooks.Open(st)
    For Each ws in wb.Worksheets
        wsRef.Cells(i, 1) = wb.Name
        wsRef.Cells(i, 2) = ws.Name
        i = i + 1
    Next
    Application.DisplayAlerts = False
    wb.Close
    Application.DisplayAlerts = True
Next

---

关于如何在web上实现这一点，已经有很多工作示例。把你的标题插入谷歌给了我不少。什么不起作用？你有错误吗？它是否只是运行而不在工作表中显示任何结果？如果出现错误，它是否会给您“调试”选项，如果是，它会突出显示哪一行代码？另外，什么是“在wb.Sheets中设置每个ws”？尝试用谷歌搜索“VBA中的每一个”。。。

dim wb as Workbook, ws as Worksheet
i = 2
For each st in coll
    Set wb = Workbooks.Open(st)
    For Each ws in wb.Worksheets
        wsRef.Cells(i, 1) = wb.Name
        wsRef.Cells(i, 2) = ws.Name
        i = i + 1
    Next
    Application.DisplayAlerts = False
    wb.Close
    Application.DisplayAlerts = True
Next