Hi Everyone,
I am a "copy and paste" with a bit of tinkering VBA user and have pinched a very useful piece of code to help with a program I have designed but I am hitting a snag that I really hope someone can help with.
The below code allows me to open and excel document, refresh the connections to an external source, save the changes and close the document for use with a linked table in my access database. Well, almost.
The problem I have is when the code runs it appears to open the document, refresh the connections, but then instead of saving the document on our network folder (G: Drive), saves it to my own personal network drive (H
. This obviously means that the workbook is updated but not in the right location! I am sure I am missing something really obvious but if anyone can make any suggestions I would be very very appreciative as I am about to lose my mind!
Function fRefreshWorkbook() As Boolean
On Error GoTo Err_fRefreshWorkbook
Dim objXL As Object, objWbk As Object, blNewInst As Boolean, _
strPathToFile As String
Const c_strFile As String = "Document.xlsx" <--- actual document name is here but replaced here just for data protection
On Error Resume Next
' See if we can grab an instance of Excel already running
Set objXL = GetObject(, "Excel.Application")
If Err <> 0 Then
' No existing instance of Excel, let's create one
Set objXL = CreateObject("Excel.Application")
' Set a flag so we know to destroy the instance after we're done
blNewInst = True
Err = 0
End If
On Error GoTo Err_fRefreshWorkbook
' Define the Excel file we want to open
strPathToFile = CurrentProject.Path & "" & c_strFile
' Open the file setting the parameter to RefreshLinks = True
Set objWbk = objXL.Workbooks.Open(strPathToFile, True)
With objWbk
.Connections("ECWL Report").Refresh
.Connections("ECWL Report1").Refresh
.Save
.Close
End With
Exit_fRefreshWorkbook:
If Not objWbk Is Nothing Then Set objWbk = Nothing
If Not objXL Is Nothing Then
If blNewInst Then objXL.Quit
Set objXL = Nothing
End If
Exit Function
Err_fRefreshWorkbook:
Select Case Err.Number
Case Else
MsgBox "Error No.: " & Err.Number & vbNewLine & vbNewLine & _
"Description: " & Err.Description & vbNewLine & vbNewLine & _
"Procedure: fRefreshWorkbook" & vbNewLine & _
IIf(Erl, "Line No: " & Erl & vbNewLine, "") & _
"Module: basTest", , "Error: " & Err.Number
End Select
Resume Exit_fRefreshWorkbook
End Function
I am a "copy and paste" with a bit of tinkering VBA user and have pinched a very useful piece of code to help with a program I have designed but I am hitting a snag that I really hope someone can help with.
The below code allows me to open and excel document, refresh the connections to an external source, save the changes and close the document for use with a linked table in my access database. Well, almost.
The problem I have is when the code runs it appears to open the document, refresh the connections, but then instead of saving the document on our network folder (G: Drive), saves it to my own personal network drive (H
. This obviously means that the workbook is updated but not in the right location! I am sure I am missing something really obvious but if anyone can make any suggestions I would be very very appreciative as I am about to lose my mind!Function fRefreshWorkbook() As Boolean
On Error GoTo Err_fRefreshWorkbook
Dim objXL As Object, objWbk As Object, blNewInst As Boolean, _
strPathToFile As String
Const c_strFile As String = "Document.xlsx" <--- actual document name is here but replaced here just for data protection
On Error Resume Next
' See if we can grab an instance of Excel already running
Set objXL = GetObject(, "Excel.Application")
If Err <> 0 Then
' No existing instance of Excel, let's create one
Set objXL = CreateObject("Excel.Application")
' Set a flag so we know to destroy the instance after we're done
blNewInst = True
Err = 0
End If
On Error GoTo Err_fRefreshWorkbook
' Define the Excel file we want to open
strPathToFile = CurrentProject.Path & "" & c_strFile
' Open the file setting the parameter to RefreshLinks = True
Set objWbk = objXL.Workbooks.Open(strPathToFile, True)
With objWbk
.Connections("ECWL Report").Refresh
.Connections("ECWL Report1").Refresh
.Save
.Close
End With
Exit_fRefreshWorkbook:
If Not objWbk Is Nothing Then Set objWbk = Nothing
If Not objXL Is Nothing Then
If blNewInst Then objXL.Quit
Set objXL = Nothing
End If
Exit Function
Err_fRefreshWorkbook:
Select Case Err.Number
Case Else
MsgBox "Error No.: " & Err.Number & vbNewLine & vbNewLine & _
"Description: " & Err.Description & vbNewLine & vbNewLine & _
"Procedure: fRefreshWorkbook" & vbNewLine & _
IIf(Erl, "Line No: " & Erl & vbNewLine, "") & _
"Module: basTest", , "Error: " & Err.Number
End Select
Resume Exit_fRefreshWorkbook
End Function
