循环遍历同一文件夹中的工作簿并为所有 VBA 执行相同的 Excel 任务

Question

我需要创建 50 多个文件来创建数据透视表，每个文件都有相同的确切内容，但内容不同。到目前为止，我已经完成了为数据透视表创建代码，并且它在单独运行时运行良好，但是，当我尝试为同一文件夹中的所有工作簿运行代码时它失败了。我不知道发生了什么以及为什么它一直显示找不到文件，尽管路径名没有任何问题。

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

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

Application.DisplayAlerts = False
Application.ScreenUpdating = False
    Set WB = Workbooks.Open(Pathname & Filename)  'open all files
    PivotX WB
    WB.Close SaveChanges:=True

Application.DisplayAlerts = True
Application.ScreenUpdating = True
    Filename = Dir()
Loop
End Sub

这是pivot的代码，单独运行时效果很好：

Sub PivotX(WB As Workbook)
Dim Lrow, Lcol As Long
Dim wsData As Worksheet
Dim rngRaw As Range
Dim PvtTabCache As PivotCache
Dim PvtTab As PivotTable
Dim wsPvtTab As Worksheet
Dim PvtFld As PivotField

Set wsData = ActiveSheet
Lrow = wsData.Cells(Rows.Count, "B").End(xlUp).Row
Lcol = wsData.Cells(1, Columns.Count).End(xlToLeft).Column
Set rngRaw = wsData.Range(Cells(1, 1), Cells(Lrow, Lcol))
Set wsPvtTab = Worksheets.Add
wsData.Select
ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:=rngRaw, Version:=xlPivotTableVersion12).CreatePivotTable TableDestination:=wsPvtTab.Range("A3"), TableName:="PivotTable1", DefaultVersion:=xlPivotTableVersion12

Set PvtTab = wsPvtTab.PivotTables("PivotTable1")

PvtTab.ManualUpdate = True
Set PvtFld = PvtTab.PivotFields("Month")
PvtFld.Orientation = xlPageField
PvtTab.PivotFields("Month").ClearAllFilters

Set PvtFld = PvtTab.PivotFields("Year")
PvtFld.Orientation = xlPageField
PvtTab.PivotFields("Year").ClearAllFilters

Set PvtFld = PvtTab.PivotFields("Fund_Code")
PvtFld.Orientation = xlRowField
PvtFld.Position = 1

Set PvtFld = PvtTab.PivotFields("Curr")
PvtFld.Orientation = xlColumnField
PvtFld.Position = 1
wsPvtTab.PivotTables("PivotTable1").PivotFields("Curr").PivotItems("USD").Position = 1

With PvtTab.PivotFields("Trx_Amount")
.Orientation = xlDataField
.Function = xlSum
.NumberFormat = "#,##0;[red](#,##0)"
End With

wsPvtTab.PivotTables("Pivottable1").RowAxisLayout xlTabularRow

'Remove grand total
wsPvtTab.PivotTables("Pivottable1").RowGrand = False

For Each PvtTbCache In ActiveWorkbook.PivotCaches
    On Error Resume Next
    PvtTbCache.Refresh
Next PvtTbCache

'Determine filter value
Set PvtFld = PvtTab.PivotFields("Year")
PvtFld.ClearAllFilters
PvtFld.EnableMultiplePageItems = True
  With PvtFld
    .AutoSort xlmnual, .SourceName
    For Each Pi In PvtFld.PivotItems
            Select Case Pi.Name
                Case "2014"
                Case Else
                    Pi.Visible = False
            End Select
    Next Pi
    .AutoSort xlAscending, .SourceName
  End With

'determine filter value
Set PvtFld = PvtTab.PivotFields("Month")
PvtFld.ClearAllFilters
PvtFld.EnableMultiplePageItems = True
  With PvtFld
    .AutoSort xlmnual, .SourceName
    For Each Pi In PvtFld.PivotItems
            Select Case Pi.Name
                Case "11"
                Case Else
                    Pi.Visible = False
            End Select
    Next Pi
    .AutoSort xlAscending, .SourceName
  End With
PvtTab.ManualUpdate = False
End Sub

任何帮助将不胜感激。非常感谢您。

Answer 1

这应该可以解决您的问题：

Set WB = Workbooks.Open(Pathname & "\" & Filename)

当我尝试使用您的代码时，由于某种原因，它没有保留您在“文件名”变量开头放置的反斜杠。这可以解释为什么 VBA 找不到文件。在路径名和文件名之间添加它应该可以正常工作

Answer 2

我相信您已经回答了上述基本问题，但我会提供以下“调整”以避免屏幕闪烁和未恢复的变量分配。

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

Set WB = Nothing 实际上仅在未重新分配 WB 时在最后一次传递中是有目的的，但您的 PivotX 子可以在退出之前使用多个 Set nnn = Nothing。虽然引用计数应该减少（并因此释放内存），但情况并非总是如此。 （见Is there a need to set Objects to Nothing inside VBA Functions）简而言之，这只是一种很好的编码实践。

最后，使用Dim Filename, Pathname As String 将文件名 声明为变体，而不是字符串类型。在这里没有任何区别，但您应该知道您的变量被声明为什么。