2017-05-03 46 views
0

早上好,我正在編寫這個代碼,它允許我在每個宏文件中打開和複製工作表,這些工作表包含在許多子文件夾中。 問題是我將所有這些文件放在一個文件夾中包含的子文件夾中,但它們具有所有不同的名稱。 我應該在這段代碼中添加什麼?打開子文件夾中的所有文件

非常感謝!

Application.EnableEvents = False 
Application.ScreenUpdating = False 

Path = ActiveWorkbook.Path 

FileName = Dir(Path & "\*.xlsm", vbNormal) 

Do Until FileName = "" 

    Set Wkb = Workbooks.Open(FileName:=Path & "\" & FileName, UpdateLinks:=3) 
    For Each ws In Wkb.Worksheets 
    Application.EnableEvents = False 
    Application.ScreenUpdating = False 
    wsName = ws.Name 
    If (wsName = "Summary (Output)") Then 
     ws.Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count) 
    Exit For 
    End If 
    Next ws 
    Wkb.Close False 
    FileName = Dir() 
Loop 

我沒有把所有的聲明,但也有:)

+1

使用'filesystemobject'並從其'folder'你可以得到'子文件夾集合 –

+2

檢查遞歸方法:http://stackoverflow.com/questions/22645347/loop-through-all-subfolders-using-vba – Zerk

回答

0

你得到一個小窗口彈出一秒鐘有些人不喜歡這種方式。

這將打開所有的.xls工作簿 - 所以XLS,XLSX,XLSM,XLSB和XLS其他任何味道

Public Sub OpenAllWorkbooks() 

    Dim vFiles As Variant 
    Dim vFile As Variant 

    vFiles = EnumerateFiles("<Folder Path including final backslash - e.g. C:\Windows\>", "xls*") 

    For Each vFile In vFiles 
     Workbooks.Open vFile 
    Next vFile 

End Sub 

Public Function EnumerateFiles(sDirectory As String, _ 
      Optional sFileSpec As String = "*", _ 
      Optional InclSubFolders As Boolean = True) As Variant 

    EnumerateFiles = Filter(Split(CreateObject("WScript.Shell").Exec _ 
     ("CMD /C DIR """ & sDirectory & "*." & sFileSpec & """ " & _ 
     IIf(InclSubFolders, "/S ", "") & "/B /A:-D").StdOut.ReadAll, vbCrLf), ".") 

End Function 
相關問題