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

我一直在嘗試編寫一些代碼，這些代碼將挖掘到目錄中的每個文件夾和子文件夾，以列出工作簿中工作表的名稱。經過這個論壇上的帖子，我得到了這麼多時間和幫助，但仍然沒有一個工作宏。我確信這很明顯，我爲戈爾道歉，但是有誰知道爲什麼它不起作用？謝謝！宏以列出文件夾和子文件夾中的所有工作表

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

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

回答

相關問題