循環遍歷同一個文件夾中的工作簿併爲所有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 

這裏是支點的代碼，並單獨運行時，它工作得很好：

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聲明文件名作爲變體，而不是字符串類型。這裏沒有什麼區別，但你應該知道你的變量被聲明爲什麼。