asked on

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!

Bill Prew

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

Jhovyn Marcos

ASKER

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

Bill Prew

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

ASKER CERTIFIED SOLUTION

Bill Prew

membership

This solution is only available to members.

To access this solution, you must be a member of Experts Exchange.

Start Free Trial

Jhovyn Marcos

ASKER

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