Donate. I desperately need donations to survive due to my health

Get paid by answering surveys Click here

Click here to donate

Remote/Work from Home jobs

refresh all pivot tables in the chosen folder

I've found the code below, and I would like to use it to refresh all pivot tables in the workbooks in the same folder. anyone can help ?

Option Explicit

Dim iCnt As Integer Dim objFSO As Object

Sub RunAll() Dim myPath As String

' Initialize count of processed files
iCnt = 0

'Retrieve Target Folder Path From User
myPath = ""
With Application.FileDialog(msoFileDialogFolderPicker)
    .Title = "Select Folder"
    .AllowMultiSelect = False
    If .Show <> -1 Then GoTo NextCode
    myPath = .SelectedItems(1) & Application.PathSeparator
End With

'In Case of Cancel

NextCode: If myPath = "" Then Exit Sub

'Create filesystem object
Set objFSO = CreateObject("Scripting.FileSystemObject")

'Optimize Macro Speed
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual

'Process folder (recursively)
Call ProcessFolder(objFSO.GetFolder(myPath))

'Reset Macro Optimization Settings
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True

Set objFSO = Nothing

MsgBox iCnt & " files processed"

End Sub

Sub ProcessFolder(objFolder As Object) Dim objSubFolder As Object Dim objFile As Object Dim pvtTbl As PivotTable

On Error Resume Next

'Check each file in folder, if Excel file process it
For Each objFile In objFolder.Files
    If Left(LCase(objFSO.GetExtensionName(objFile.Path)), 3) = "xls" Then
        Call ProcessFile(objFile.Path)
    End If

Next

    For Each pvtTbl In ActiveSheet.PivotTables
    pvtTbl.RefreshTable
Next


'Drill down into all subfolders recursively
If Err.Number = 0 Then
    For Each objSubFolder In objFolder.Subfolders
        Call ProcessFolder(objSubFolder)
    Next
End If

End Sub

Private Sub ProcessFile(strFile As String) Dim WB As Workbook

'Add to processed files count
iCnt = iCnt + 1

'Set variable equal to opened workbook
Set WB = Workbooks.Open(filename:=strFile)

'Ensure Workbook has opened before moving on to next line of code
DoEvents

pvtTbl.RefreshTable


'Save and Close Workbook
WB.Close savechanges:=True

'Ensure Workbook has closed before moving on to next line of code
DoEvents

End Sub

Comments