VBA to open, update links, save, and close files.

[jaihawk8]

I have 75 earning statements that all reside in the same folder.

When I manually update them, I:

• Open each file in Excel
• I receive a message box saying "This workbook contains links to one or more external sources that could be unsafe. If you trust the links, update them to get the latest data. Otherwise, you can keep working with the date you have."
• I click on the update button
• The file updates
• I click save
• I close the file

I am hoping to find a VBA solution that would open each one of the files automatically and do the steps listed above.

Is this possible?

 

[breynolds0431]

I have the below for something similar that opens all excel files in a folder, copies out the data pastes to a source workbook. I removed that part and added the update links part. Hopefully that will work for you.

Add this to a class module:

Option Explicit
Const FOLDER_PATH = ""  'Add folder path here and include the ending backslash

Sub ImportWorksheets()

Dim sFile As String 'file to process
Dim wbSource As Workbook

'check the folder exists, which could be due to being disconnected from a network
If Not FileFolderExists(FOLDER_PATH) Then
   MsgBox "Specified folder does not exist, exiting!"
   Exit Sub
End If

'reset application settings in event of error
On Error GoTo errHandler
Application.ScreenUpdating = False

'loop through the Excel files in the folder
sFile = Dir(FOLDER_PATH & "*.xls*")
     
Do Until sFile = ""
          'open the file
          Set wbSource = Workbooks.Open(FOLDER_PATH & sFile)
       
          'update the data links
           ActiveWorkbook.UpdateLink Name:=ActiveWorkbook.LinkSources, Type:=xlExcelLinks
         
          'close the file
          wbSource.Close savechanges:=True
Loop

Application.ScreenUpdating = True
 
errHandler:
   On Error Resume Next
   Application.ScreenUpdating = True
   Set wbSource = Nothing
End Sub

Private Function FileFolderExists(strPath As String) As Boolean
    If Not Dir(strPath, vbDirectory) = vbNullString Then FileFolderExists = True
End Function

 

[breynolds0431]

Also, you may have to manually set each workbook to "Don't display the alert and update links" option in the Startup Prompt of the Edit Links dialog (Data>Edit Links>Startup Prompt). You can also add this ActiveWorkbook.UpdateLinks = xlUpdateLinksAlways to the Loop with the ActiveWorkbook.UpdateLink Name:=ActiveWorkbook.LinkSources, Type:=xlExcelLinks part. The first time looping will likely bring up the edit links prompt, however.

 

[jaihawk8]

Thank you for this. This is what I copied into the Module, but when I run it, nothing happens. Am I doing something wrong?

Option Explicit
Const FOLDER_PATH = "C:\Users\jbohl\OneDrive - Quadient\Central District\2022 Payroll Files\Quarterly Bonus\Statements\Terminated Employees\" 'Add folder path here and include the ending backslash

Sub ImportWorksheets()

Dim sFile As String 'file to process
Dim wbSource As Workbook

'check the folder exists, which could be due to being disconnected from a network
If Not FileFolderExists(FOLDER_PATH) Then
MsgBox "Specified folder does not exist, exiting!"
Exit Sub
End If

'reset application settings in event of error
On Error GoTo errHandler
Application.ScreenUpdating = False

'loop through the Excel files in the folder
sFile = Dir(FOLDER_PATH & "*.xlm*")

Do Until sFile = ""
'open the file
Set wbSource = Workbooks.Open(FOLDER_PATH & sFile)

'update the data links
ActiveWorkbook.UpdateLink Name:=ActiveWorkbook.LinkSources, Type:=xlExcelLinks

'close the file
wbSource.Close savechanges:=True
Loop

Application.ScreenUpdating = True

errHandler:
On Error Resume Next
Application.ScreenUpdating = True
Set wbSource = Nothing
End Sub

Private Function FileFolderExists(strPath As String) As Boolean
If Not Dir(strPath, vbDirectory) = vbNullString Then FileFolderExists = True
End Function

 

[breynolds0431]

It may be due to the sFile = Dir(FOLDER_PATH & "*.xlm*") part. This is looking in the folder for all macro-enabled excel files.

Assuming your excel files are in .xlsx format, try changing to sFile = Dir(FOLDER_PATH & "*.xls*")

 

[jaihawk8]

It may be due to the sFile = Dir(FOLDER_PATH & "*.xlm*") part. This is looking in the folder for all macro-enabled excel files.

Assuming your excel files are in .xlsx format, try changing to sFile = Dir(FOLDER_PATH & "*.xls*")

My files are all .xlsm files.

 

[breynolds0431]

My files are all .xlsm files.

Okay, then that part should be sFile = Dir(FOLDER_PATH & "*.xlsm*"). You have "*.xlm*".

 

[jaihawk8]

Okay, then that part should be sFile = Dir(FOLDER_PATH & "*.xlsm*"). You have "*.xlm*".

OK, that worked, but now when I run it, it just keeps opening the same file (1st file in the folder) over and over again.

 

[breynolds0431]

OK, that worked, but now when I run it, it just keeps opening the same file (1st file in the folder) over and over again.

Sorry about that, the sFile needs to be reset prior to the Loop.

Option Explicit
Const FOLDER_PATH = "C:\Users\jbohl\OneDrive - Quadient\Central District\2022 Payroll Files\Quarterly Bonus\Statements\Terminated Employees\"  'Add folder path here and include the ending backslash

Sub ImportWorksheets()

Dim sFile As String 'file to process
Dim wbSource As Workbook

'check the folder exists, which could be due to being disconnected from a network
If Not FileFolderExists(FOLDER_PATH) Then
   MsgBox "Specified folder does not exist, exiting!"
   Exit Sub
End If

'reset application settings in event of error
On Error GoTo errHandler
Application.ScreenUpdating = False

'loop through the Excel files in the folder
sFile = Dir(FOLDER_PATH & "*.xls*")
     
Do Until sFile = ""
          'open the file
          Set wbSource = Workbooks.Open(FOLDER_PATH & sFile)
       
          'update the data links
          ActiveWorkbook.UpdateLink Name:=ActiveWorkbook.LinkSources, Type:=xlExcelLinks
         
          'close the file
          wbSource.Close savechanges:=True
          
          sFile = Dir() 'Added to reset sFile
Loop

Application.ScreenUpdating = True
 
errHandler:
   On Error Resume Next
   Application.ScreenUpdating = True
   Set wbSource = Nothing
End Sub

Private Function FileFolderExists(strPath As String) As Boolean
    If Not Dir(strPath, vbDirectory) = vbNullString Then FileFolderExists = True
End Function

 

[jaihawk8]

That worked like a charm! Last question, and I should have probably asked this first. Is there a way for it to open the file and then make sure it's on a certain worksheet tab when it closes to save it? For example, each quarter has its own tab. I'd like to be able to have them all save on Q2 tab.

Thanks again for all of your help!