VBA Excel循环遍历文件夹

Question

我尝试在同一文件夹中的多个工作簿上运行一个宏。我目前有以下内容，但是当我运行它时（通过在 VBA 中使用 F5 for excel），没有任何反应。 excel VBA 窗口只是闪烁，但没有任何工作簿，甚至是第一个工作簿，都受到宏的影响。如果有帮助，有时 F5 会要求我确认我正在运行“Sheet1.DoAllFiles”。我是个初学者，所以我确信这是我所缺少的一些简单的东西——但是任何帮助让这个程序循环的帮助都将不胜感激。谢谢！

我找到的循环代码：

Sub DoAllFiles()
Dim Filename, Pathname As String
Dim WB As Workbook

'Pathname = "G:\Google Drive\2013-2014\Testingbeforedeployment"
'One pathname is coded out depending on what computer I'm running it from
Pathname = "C:\Users\Maptop\Google Drive\2013-2014\Testingbeforedeployment"
Filename = Dir(Pathname & "\*.xls*")
Do While Filename <> ""

Application.DisplayAlerts = False
Application.ScreenUpdating = False
Do While Filename <> ""
    Set WB = Workbooks.Open(Pathname & "\" & Filename)  'open all files
    Call Simplify(WB)
    WB.Close SaveChanges:=True
    Set WB = Nothing
    Filename = Dir()
Loop
Application.DisplayAlerts = True
Application.ScreenUpdating = True
Loop
End Sub

我的循环应该调用的宏：

Private Sub Simplify(WB As Workbook)
Sheets.Add After:=Sheets(Sheets.Count)
Const tlh As String = "Credited"
    With Sheets("Inventory") 'Change to suit
        Dim tl As Range, bl As Range
        Dim first_add As String, tbl_loc As Variant
        Set tl = .Cells.Find(tlh)
        If Not tl Is Nothing Then
            first_add = tl.Address
        Else
            MsgBox "Table does not exist.": Exit Sub
        End If
        Do
            If Not IsArray(tbl_loc) Then
                tbl_loc = Array(tl.Address)
            Else
                ReDim Preserve tbl_loc(UBound(tbl_loc) + 1)
                tbl_loc(UBound(tbl_loc)) = tl.Address
            End If
            Set tl = .Cells.FindNext(tl)
        Loop While tl.Address <> first_add
        Dim i As Long, lrow As Long, tb_cnt As Long: tb_cnt = 0
        For i = LBound(tbl_loc) To UBound(tbl_loc)
            Set bl = .Cells.Find(vbNullString, .Range(tbl_loc(i)) _
                , , , xlByColumns, xlNext)
            lrow = Sheets("Sheet1").Range("A" & _
                   Sheets("Sheet1").Rows.Count).End(xlUp).Row
            .Range(.Range(tbl_loc(i)).Offset(0, 3)(IIf(tb_cnt <> 0, 1, 0),     0), _
                bl.Offset(-1, 0)).Resize(, 9).Copy _
                Sheets("Sheet1").Range("A" & lrow).Offset(IIf(lrow = 1, 0,     1), 0)
            tb_cnt = tb_cnt + 1
            Set bl = Nothing
        Next
    End With
End Sub

Answer 1

你有一个额外的Do While...Loop在那里......

Sub DoAllFiles()

    Dim Filename, Pathname As String
    Dim WB As Workbook

    'Pathname = "G:\Google Drive\2013-2014\Testingbeforedeployment"
    Pathname = "C:\Users\Maptop\Google Drive\2013-2014\Testingbeforedeployment"

    Filename = Dir(Pathname & "\*.xls*")
    Do While Filename <> ""

        Application.DisplayAlerts = False
        Application.ScreenUpdating = False

        Set WB = Workbooks.Open(Pathname & "\" & Filename)  'open all files
        Simplify WB '<<<EDIT
        WB.Close SaveChanges:=True

        Application.DisplayAlerts = True
        Application.ScreenUpdating = True

        Filename = Dir()

    Loop

End Sub

在您的Simplify() Sub 中，您似乎从未引用过WB，并且您的所有Sheets 引用都没有 Workbook 限定符：默认情况下，它们将引用 ActiveWorkbook，但您不应该依赖它。从您的代码中，不清楚您是打算在 WB 中还是在包含代码的工作簿中引用工作表。