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

我一直在尝试编写一些代码，这些代码将挖掘到目录中的每个文件夹和子文件夹，以列出工作簿中工作表的名称。经过这个论坛上的帖子，我得到了这么多时间和帮助，但仍然没有一个工作宏。我确信这很明显，我为戈尔道歉，但是有谁知道为什么它不起作用？谢谢！宏以列出文件夹和子文件夹中的所有工作表

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

来源

2017-02-16 brianabrownesq

有很多已经在使用的示例说明如何在Web上执行此操作。只需将你的标题插入谷歌给了我不少。 –

什么不工作？你有错误吗？它是否在您的工作表中不显示任何结果的情况下运行？如果出现错误，是否提供了“调试”选项，如果有的话，它会突出显示哪行代码？ – Blackhawk

另外，什么是“在wb.Sheets中设置每个ws”？试用Google搜索“For ... Each in VBA”... – Blackhawk

我看到你有一个对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

就这样，你只需要你的主要模块运行：

dim Coll as New Collection 
Const Addr As String = "G:\EP\Projects\" 
Call ExtractAllWorkbooks(Addr, Coll)

现在您应该拥有集合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

来源

2017-02-16 16:46:14

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

回答

相关问题