VBA - How to refresh Multiple Workbook w/ Pivot Table inside multiple subfolder?

Hi All!
I have read this article here Source   and this is very helpful to me. I'm currently using this code.

I have multiple workbooks in my folder and also in my subfolder. The problem here is that the "refreshall" doesn't included my other workbooks inside my subfolder. It only refresh on a specific folder but not refreshing in subfolder.

Is it possible to include my multiple subfolder from refreshing using this code below? Please help me how to do this.


Sub LoopAllExcelFilesInFolder()
'PURPOSE: To loop through all Excel files in a user specified folder and perform a set task on them
'SOURCE: www.TheSpreadsheetGuru.com

Dim wb As Workbook
Dim myPath As String
Dim myFile As String
Dim myExtension As String
Dim FldrPicker As FileDialog

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

'Retrieve Target Folder Path From User
  Set FldrPicker = Application.FileDialog(msoFileDialogFolderPicker)

    With FldrPicker
      .Title = "Select A Target Folder"
      .AllowMultiSelect = False
        If .Show <> -1 Then GoTo NextCode
        myPath = .SelectedItems(1) & "\"
    End With

'In Case of Cancel
NextCode:
  myPath = myPath
  If myPath = "" Then GoTo ResetSettings

'Target File Extension (must include wildcard "*")
  myExtension = "*.xls*"

'Target Path with Ending Extention
  myFile = Dir(myPath & myExtension)

'Loop through each Excel file in folder
  Do While myFile <> ""
    'Set variable equal to opened workbook
      Set wb = Workbooks.Open(Filename:=myPath & myFile)
    
    'Ensure Workbook has opened before moving on to next line of code
      DoEvents
    
    'Change First Worksheet's Background Fill Blue
      wb.Worksheets(1).Range("A1:Z1").Interior.Color = RGB(51, 98, 174)
    
    'Save and Close Workbook
      wb.Close SaveChanges:=True
      
    'Ensure Workbook has closed before moving on to next line of code
      DoEvents

    'Get next file name
      myFile = Dir
  Loop

'Message Box when tasks are completed
  MsgBox "Task Complete!"

ResetSettings:
  'Reset Macro Optimization Settings
    Application.EnableEvents = True
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
End Sub

Open in new window



All is well!
Jhovyn MarcosAsked:
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

Bill PrewCommented:
Give this a try, add in a new module and run RunAll().

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
  
    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

    '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
    
    'Change First Worksheet's Background Fill Blue
    wb.Worksheets(1).Range("A1:Z1").Interior.Color = RGB(51, 98, 174)
    
    'Save and Close Workbook
    wb.Close SaveChanges:=True
      
    'Ensure Workbook has closed before moving on to next line of code
    DoEvents
End Sub

Open in new window


»bp
0
Jhovyn MarcosAuthor Commented:
@Bill Prew

Hi Sir,
Thank you for your great time. I've already tried your code but it did not refresh my Pivot. Take note that I have different excel file format which are xlsx and xlsm also.

All is well!
0
Bill PrewCommented:
I thought your question was how to get the logic you had to process files in subfolders, I assumed that logic was doing what you wanted in a single folder.

So you don't have anything working that refreshes all pivot tables in all excel files, and that is what you are looking for?

What is the "refreshall" you referred to?


»bp
0
Bill PrewCommented:
Give this a try.

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
  
    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

    '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
    Dim pt As PivotTable
    Dim ws As Worksheet

    '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
    
    'Update pivot tables
    For Each ws In wb.Worksheets
        ws.Calculate
        For Each pt In ws.PivotTables
            pt.RefreshTable
        Next pt
    Next ws
    
    'Save and Close Workbook
    wb.Close SaveChanges:=True
      
    'Ensure Workbook has closed before moving on to next line of code
    DoEvents
End Sub

Open in new window


»bp
1

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
Jhovyn MarcosAuthor Commented:
@Bill Prew
Hi Sir! Sorry for the late reply! This is awesome Sir! It's perfectly working :) ! Thank you for sharing your knowledge!


God Bless you!
0
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
VBA

From novice to tech pro — start learning today.

Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.