Get data from dynamic location and filename on closed workbook using VBA

Joe006

New Member
Joined
Nov 20, 2023
Messages
23
Office Version
  1. 2016
Platform
  1. Windows
1700555158018.png


Hi, I got a lot of excel files in different location where each files is put in folder named month and year. I need to get the data from it while it's closed and data is pulled based on the drop down list for the month and the year. I have tried using the INDIRECT function and it work only when the file is opened. I just discovered that need to use VBA script to pull while it closed, if using VBA, how to call the data and set formula for the folder name and file dynamically according the chosen drop down list ?

Any helps much appreciated, Thank you
 
to clearly, i want to confirm that E2 equals with sum of all F6 values in input data files and B6 to E6 equals with values of C12 to F12 in file that named as "90XX SMod.xlsx". Is that true?
Yes true. E5 is the sum all F6 not E2
 
Upvote 0

Excel Facts

Get help while writing formula
Click the italics "fx" icon to the left of the formula bar to open the Functions Arguments dialog. Help is displayed for each argument.
Yes true. E5 is the sum all F6 not E2
try this:
VBA Code:
Private Sub GetFiles()
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Dim pFol As String, xcode As String
    Dim fso As Object, fol As Object, subFol As Object, fil As Object
    Dim filPath As String
    Dim wb As Workbook
    Dim i As Integer
    With ThisWorkbook.Sheets(1)
        .Range("E5").Value = Empty
        pFol = "D:\OT Management" 'change it to your OT Management path"
        xcode = Format(.Range("B2").Value, "00") & .Range("C2").Value
        Set fso = CreateObject("Scripting.FileSystemObject")
        Set fol = fso.GetFolder(pFol)
        For Each subFol In fol.SubFolders 'loop through each folder in your parent folder to find match folder with month and year
            If subFol.Name = xcode Then
                For Each fil In subFol.Files
                    filPath = fso.GetAbsolutePathName(fil)
                    If filPath Like "*.xlsx" Then 'open each excel file and recalculate summary worksheet
                        Set wb = Workbooks.Open(filPath)
                        .Range("E5").Value = .Range("E5").Value + wb.Sheets("Summary").Range("F6").Value 'sum F6 in all input files
                        If wb.Name Like "90## SMod.xlsx" Then 'check that input file named as Smod
                            For i = 0 To 3
                                .Range("B6").Offset(, i).Value = wb.Sheets("Summary").Range("C12").Offset(, i).Value
                            Next i
                        End If
                        wb.Close (False)
                    End If
                Next fil
            End If
        Next subFol
    End With
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
End Sub
 
Upvote 0
try this:
VBA Code:
Private Sub GetFiles()
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Dim pFol As String, xcode As String
    Dim fso As Object, fol As Object, subFol As Object, fil As Object
    Dim filPath As String
    Dim wb As Workbook
    Dim i As Integer
    With ThisWorkbook.Sheets(1)
        .Range("E5").Value = Empty
        pFol = "D:\OT Management" 'change it to your OT Management path"
        xcode = Format(.Range("B2").Value, "00") & .Range("C2").Value
        Set fso = CreateObject("Scripting.FileSystemObject")
        Set fol = fso.GetFolder(pFol)
        For Each subFol In fol.SubFolders 'loop through each folder in your parent folder to find match folder with month and year
            If subFol.Name = xcode Then
                For Each fil In subFol.Files
                    filPath = fso.GetAbsolutePathName(fil)
                    If filPath Like "*.xlsx" Then 'open each excel file and recalculate summary worksheet
                        Set wb = Workbooks.Open(filPath)
                        .Range("E5").Value = .Range("E5").Value + wb.Sheets("Summary").Range("F6").Value 'sum F6 in all input files
                        If wb.Name Like "90## SMod.xlsx" Then 'check that input file named as Smod
                            For i = 0 To 3
                                .Range("B6").Offset(, i).Value = wb.Sheets("Summary").Range("C12").Offset(, i).Value
                            Next i
                        End If
                        wb.Close (False)
                    End If
                Next fil
            End If
        Next subFol
    End With
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
End Sub
1700702800083.png


Hi thanks for your help, the code works , just each time the workbook opened need to click either update and dont update to make it closes. Currently, i'm trying to figuring out on how make it run automatically or trigger it by button
 
Upvote 0
I'm trying to modify this line code to also loop and to pull data and calculate to the cell B5 to E5, is this code correct?:
VBA Code:
 For Each fil In subFol.Files
                    filPath = fso.GetAbsolutePathName(fil)
                    If filPath Like "*.xlsx" Then 'open each excel file and recalculate summary worksheet
                        Set wb = Workbooks.Open(filPath)
                        
                        For i = 0 To 3
                                .Range("B5").Offset(, i).Value wb.Sheets("Summary").Range("C6").Offset(, i).Value
                            Next i
                            
                        .Range("E5").Value = .Range("E5").Value + wb.Sheets("Summary").Range("F6").Value 'sum F6 in all input files
                        
                        
                        If wb.Name Like "9023 SMold.xlsx" Then 'check that input file named as Smod
                            For i = 0 To 3
                                .Range("B6").Offset(, i).Value = wb.Sheets("Summary").Range("C12").Offset(, i).Value
                            Next i
                        End If
                        wb.Close (False)
                    End If
1700704344341.png
 
Upvote 0
View attachment 102344

Hi thanks for your help, the code works , just each time the workbook opened need to click either update and dont update to make it closes. Currently, i'm trying to figuring out on how make it run automatically or trigger it by button
try to change this code:
VBA Code:
Set wb = Workbooks.Open(filPath, 0)
with 0 is not update link
 
Upvote 0
I'm trying to modify this line code to also loop and to pull data and calculate to the cell B5 to E5, is this code correct?:
VBA Code:
 For Each fil In subFol.Files
                    filPath = fso.GetAbsolutePathName(fil)
                    If filPath Like "*.xlsx" Then 'open each excel file and recalculate summary worksheet
                        Set wb = Workbooks.Open(filPath)
                       
                        For i = 0 To 3
                                .Range("B5").Offset(, i).Value wb.Sheets("Summary").Range("C6").Offset(, i).Value
                            Next i
                           
                        .Range("E5").Value = .Range("E5").Value + wb.Sheets("Summary").Range("F6").Value 'sum F6 in all input files
                       
                       
                        If wb.Name Like "9023 SMold.xlsx" Then 'check that input file named as Smod
                            For i = 0 To 3
                                .Range("B6").Offset(, i).Value = wb.Sheets("Summary").Range("C12").Offset(, i).Value
                            Next i
                        End If
                        wb.Close (False)
                    End If
View attachment 102346
but E5 equals to sum of all input worksheets right?, if you change code like that, it only loop and get data in all input files and finish with data of last worksheet
 
Upvote 0
but E5 equals to sum of all input worksheets right?, if you change code like that, it only loop and get data in all input files and finish with data of last worksheet
oh sorry, actually B5 to E5 will sumup from all sheet, just it get data from different cells, B5 pull from C6, C5 pull from D6 and so on...
 
Upvote 0
oh sorry, actually B5 to E5 will sumup from all sheet, just it get data from different cells, B5 pull from C6, C5 pull from D6 and so on...
try this:
VBA Code:
Private Sub GetFiles()
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Dim pFol As String, xcode As String
    Dim fso As Object, fol As Object, subFol As Object, fil As Object
    Dim filPath As String
    Dim wb As Workbook
    Dim i As Integer
    With ThisWorkbook.Sheets(1)
        .Range("B5:E5").Value = Empty 'change this to reset sum range
        pFol = "D:\OT Management"
        xcode = Format(.Range("B2").Value, "00") & .Range("C2").Value
        Set fso = CreateObject("Scripting.FileSystemObject")
        Set fol = fso.GetFolder(pFol)
        For Each subFol In fol.SubFolders
            If subFol.Name = xcode Then
                For Each fil In subFol.Files
                    filPath = fso.GetAbsolutePathName(fil)
                    If filPath Like "*.xlsx" Then
                        Set wb = Workbooks.Open(filPath, 0) 'open with not update link
                        For i = 0 To 3
                            .Range("B5").Offset(, i).Value = .Range("B5").Offset(, i).Value + wb.Sheets("Summary").Range("C6").Offset(, i).Value 'change this to sum C6~F6
                            If wb.Name Like "90## SMod.xlsx" Then
                                .Range("B6").Offset(, i).Value = wb.Sheets("Summary").Range("C12").Offset(, i).Value
                            End If
                        Next i
                        wb.Close (False)
                    End If
                Next fil
            End If
        Next subFol
    End With
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
End Sub
 
Upvote 1
Solution
try this:
VBA Code:
Private Sub GetFiles()
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Dim pFol As String, xcode As String
    Dim fso As Object, fol As Object, subFol As Object, fil As Object
    Dim filPath As String
    Dim wb As Workbook
    Dim i As Integer
    With ThisWorkbook.Sheets(1)
        .Range("B5:E5").Value = Empty 'change this to reset sum range
        pFol = "D:\OT Management"
        xcode = Format(.Range("B2").Value, "00") & .Range("C2").Value
        Set fso = CreateObject("Scripting.FileSystemObject")
        Set fol = fso.GetFolder(pFol)
        For Each subFol In fol.SubFolders
            If subFol.Name = xcode Then
                For Each fil In subFol.Files
                    filPath = fso.GetAbsolutePathName(fil)
                    If filPath Like "*.xlsx" Then
                        Set wb = Workbooks.Open(filPath, 0) 'open with not update link
                        For i = 0 To 3
                            .Range("B5").Offset(, i).Value = .Range("B5").Offset(, i).Value + wb.Sheets("Summary").Range("C6").Offset(, i).Value 'change this to sum C6~F6
                            If wb.Name Like "90## SMod.xlsx" Then
                                .Range("B6").Offset(, i).Value = wb.Sheets("Summary").Range("C12").Offset(, i).Value
                            End If
                        Next i
                        wb.Close (False)
                    End If
                Next fil
            End If
        Next subFol
    End With
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
End Sub
Thanks for your help, this works perfectly, now i working on the form button controls to start the code.
 
Upvote 0
try this:
VBA Code:
Private Sub GetFiles()
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Dim pFol As String, xcode As String
    Dim fso As Object, fol As Object, subFol As Object, fil As Object
    Dim filPath As String
    Dim wb As Workbook
    Dim i As Integer
    With ThisWorkbook.Sheets(1)
        .Range("B5:E5").Value = Empty 'change this to reset sum range
        pFol = "D:\OT Management"
        xcode = Format(.Range("B2").Value, "00") & .Range("C2").Value
        Set fso = CreateObject("Scripting.FileSystemObject")
        Set fol = fso.GetFolder(pFol)
        For Each subFol In fol.SubFolders
            If subFol.Name = xcode Then
                For Each fil In subFol.Files
                    filPath = fso.GetAbsolutePathName(fil)
                    If filPath Like "*.xlsx" Then
                        Set wb = Workbooks.Open(filPath, 0) 'open with not update link
                        For i = 0 To 3
                            .Range("B5").Offset(, i).Value = .Range("B5").Offset(, i).Value + wb.Sheets("Summary").Range("C6").Offset(, i).Value 'change this to sum C6~F6
                            If wb.Name Like "90## SMod.xlsx" Then
                                .Range("B6").Offset(, i).Value = wb.Sheets("Summary").Range("C12").Offset(, i).Value
                            End If
                        Next i
                        wb.Close (False)
                    End If
                Next fil
            End If
        Next subFol
    End With
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
End Sub

if I change (filPath, 1) this will update link right?

VBA Code:
Set wb = Workbooks.Open(filPath, 1) 'open with not update link
 
Upvote 0

Forum statistics

Threads
1,223,903
Messages
6,175,284
Members
452,630
Latest member
OdubiYouth

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top