打开子文件夹中的所有文件

时间:2017-05-03 16:06:05

标签: excel vba excel-vba directory

早上好,我正在编写这段代码,允许我打开并复制我在许多子文件夹中的每个宏文件中的工作表。 问题是我将所有这些文件都包含在文件夹中的子文件夹中,但它们具有所有不同的名称。 我应该在此代码中添加什么内容?

非常感谢!

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 个答案:

答案 0 :(得分: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