Updating query connections when database is moved

[paul_mcc]

I'm trying to write VBA code that will update the queries in an Excel spreadsheet when the database they reference is moved.

Clients want to be able to share the database and linked spreadsheet across a number of computers as well as a network.

I've tried examples on the web that are meant to update connection strings etc but none seem to work.

I've been puzzling over this for a couple of weeks now, any help is hugely appreciated.

I've attached below a couple of macros of me creating the query links with both the ODBC and OLEDB engines - I can create the queries to run on either engine, so whichever one can be easily adjusted for a new file location I will gladly use.

Thanks very much,
Paul



With ActiveSheet.ListObjects.Add(SourceType:=0, Source:=Array(Array( _
"ODBC;DSN=MS Access Database;DBQ=C:\Users\Toshiba\Desktop\Draft.accdb;DefaultDir=C:\Users\Toshiba\Desktop;DriverId=25;FIL=MS Access;M" _
), Array("axBufferSize=2048;PageTimeout=5;")), Destination:=Range("$A$1")). _
QueryTable
.CommandText = Array( _
"SELECT Feb.ID, Feb.day, Feb.month" & Chr(13) & "" & Chr(10) & "FROM `C:\Users\Toshiba\Desktop\Draft.accdb`.Feb Feb" _
)
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.PreserveColumnInfo = True
.ListObject.DisplayName = "Table_Query_from_MS_Access_Database14"
.Refresh BackgroundQuery:=False
End With
End Sub
Sub record_oledb()
'
' record_oledb Macro
'

'
With ActiveSheet.ListObjects.Add(SourceType:=0, Source:=Array( _
"OLEDB;Provider=Microsoft.ACE.OLEDB.12.0;Password="""";User ID=Admin;Data Source=C:\Users\Toshiba\Desktop\Draft.accdb;Mode=Share Deny Wri" _
, _
"te;Extended Properties="""";Jet OLEDB:System database="""";Jet OLEDB:Registry Path="""";Jet OLEDBatabase Password="""";Jet OLEDB:Engin" _
, _
"e Type=6;Jet OLEDBatabase Locking Mode=0;Jet OLEDB:Global Partial Bulk Ops=2;Jet OLEDB:Global Bulk Transactions=1;Jet OLEDB:Ne" _
, _
"w Database Password="""";Jet OLEDB:Create System Database=False;Jet OLEDB:Encrypt Database=False;Jet OLEDBon't Copy Locale on Co" _
, _
"mpact=False;Jet OLEDB:Compact Without Replica Repair=False;Jet OLEDB:SFP=False;Jet OLEDB:Support Complex Data=False;Jet OLEDB:By" _
, "pass UserInfo Validation=False"), Destination:=Range("$F$1")).QueryTable
.CommandType = xlCmdTable
.CommandText = Array("Feb Query")
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.PreserveColumnInfo = True
.SourceDataFile = "C:\Users\Toshiba\Desktop\Draft.accdb"
.ListObject.DisplayName = "Table_Draft.accdb15"
.Refresh BackgroundQuery:=False
End With
End Sub