Sub RelinkTablesToAccess() Dim rst As DAO.Recordset Dim intNumTables As Integer Dim varReturn As Variant Dim intI As Integer Dim tdf As TableDef Dim fd As Office.FileDialog Dim vrtSelectedItem As Variant Dim sFileName As String Dim tableName As String On Error Resume Next Set rst = CurrentDb.OpenRecordset("AcctExec", dbOpenDynaset) 'check for failure - the link must be bad. If Err <> 0 Then 'get the new location Set fd = Application.FileDialog(msoFileDialogFilePicker) fd.Title = "Please select the backend database" fd.Filters.Clear fd.Filters.Add "Access Databases", "*.accdb" If fd.Show = True Then For Each vrtSelectedItem In fd.SelectedItems sFileName = vrtSelectedItem Next End If 'Rebuild the links. Check for the number of tables first intNumTables = CurrentDb.TableDefs.Count varReturn = SysCmd(acSysCmdInitMeter, "Relinking tables", intNumTables) 'Loop through all tables. Reattach those with nonzero-length Connect strings intI = 0 For Each tdf In CurrentDb.TableDefs 'if connect is blank, it's not a linked table If Len(tdf.Connect) > 0 Then intI = intI + 1 'tdf.Connect = ";DATABASE=" & sFileName CurrentDb.TableDefs.Delete tdf.name tableName = tdf.name Set tdf = CurrentDb.CreateTableDef(tableName) tdf.Connect = ";DATABASE=" & sFileName tdf.SourceTableName = tableName tdf.RefreshLink CurrentDb.TableDefs.Append tdf End If varReturn = SysCmd(acSysCmdUpdateMeter, intI) Next tdf varReturn = SysCmd(acSysCmdRemoveMeter) End If End Sub
Sub RelinkTablesToSqlServer() Dim intNumTables As Integer Dim varReturn As Variant Dim intI As Integer Dim tdf As TableDef Dim fd As Office.FileDialog Dim vrtSelectedItem As Variant Dim serverName As String Dim dbName As String Dim tableName As String 'Rebuild the links. Check for the number of tables first intNumTables = CurrentDb.TableDefs.Count varReturn = SysCmd(acSysCmdInitMeter, "Relinking tables", intNumTables) serverName = "MyServer" dbName = "MyDatabase" 'Loop through all tables. Reattach those with nonzero-length Connect strings intI = 0 For Each tdf In CurrentDb.TableDefs 'if connect is blank, it's not a linked table If Len(tdf.Connect) > 0 Then intI = intI + 1 'tdf.Connect = ";DATABASE=" & sFileName tableName = "dbo." & tdf.name tdf.Connect = TableConnect(serverName, dbName, tableName, True, "MyUser", "MyPassword") tdf.RefreshLink End If varReturn = SysCmd(acSysCmdUpdateMeter, intI) Next tdf varReturn = SysCmd(acSysCmdRemoveMeter) End Sub '================================================================================================== Private Function TableConnect(serverName As String, dbName As String, targetTable As String, _ Optional trustedConnection As Boolean = True, Optional userName As String = "", Optional password _ As String = "") As String Dim result As String If trustedConnection Then result = "ODBC;DRIVER=SQL Server;SERVER={server};DATABASE={db};Trusted_Connection=Yes" Else result = "ODBC;DRIVER=SQL Server;SERVER={server};UID={username};PWD={password};DATABASE={db}" End If result = Replace$(result, "{server}", serverName) result = Replace$(result, "{db}", dbName) result = Replace$(result, "{table}", targetTable) result = Replace$(result, "{username}", userName) result = Replace$(result, "{password}", password) TableConnect = result End Function
ScrewTurn Wiki version 3.0.1.400. Some of the icons created by FamFamFam. Except where noted, all contents Copyright © 1999-2024, Patrick Jasinski.