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

我有超过50个文件需要创build数据透视表和每个文件具有相同的确切forms与不同的内容。 到目前为止，我已经完成了创build数据透视表的代码，并且它在单独运行时工作得非常好，但是，当我尝试在同一个文件夹中运行所有工作簿的代码时失败了。 我不知道发生了什么，为什么它一直显示没有文件可以被发现，尽pipepath名没有错。

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) 

当我尝试使用你的代码时，出于某种原因，它并没有保留你在“Filename”variables开头的反斜杠。 这将解释为什么VBA无法find文件。 在path名和文件名之间添加它应该使其正确工作

Answer 2

我相信你有上面的基本问题的答案，但我会提供以下“调整”，以避免屏幕闪烁和未恢复的variables分配。

 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退出之前。 虽然引用计数应该减less（并且释放内存），但情况并非总是如此。 （请参阅VBA函数中是否需要将对象设置为Nothing ）总之，这只是良好的编码习惯。

最后，使用Dim Filename, Pathname As String Filename声明为变体，而不是stringtypes。 这里没有什么区别，但是你应该知道你的variables被声明为什么。