Here's some code that I put together a millenium ago (circa '96). You
will need to tweak it since I copied it as-is from the db. I do not
remember the original source of the code. (Access Developer's Handbook
by Sybex???) You will also need to create a form named USysAdvisory with
a text label named Advisory or of course delete the appropriate lines
from the code. The form provides the user with an idea of how the
process is going.
'Function Change_Database_Connection()
' Update connection information in attached tables.
'
' Number of attached tables for progress meter.
' Const NONEXISTENT_TABLE = 3011
' Const FILE_NOT_FOUND = 3024
' Const ACCESS_DENIED = 3051
' Const READ_ONLY_DATABASE = 3027
'
' Dim intTableCount As Integer
' Dim filename As String, SearchPath As String, Temp As String
' Dim strSQLText As String
' Dim ReturnValue As Variant, I As Integer, MsgText As String
' Dim MyTable As TableDef
' Dim MyDB As Database, MyRecords As Recordset
' Set MyDB = DBEngine.Workspaces(0).Databases(0)
' Change_Database_Connection = True
' Continue if attachments are broken.
'On Error Resume Next
' Open attached table to see if connection information is correct.
' Set MyRecords = MyDB.OpenRecordset("Inquiries")
' Exit if connection information is correct.
' Skip since we're changing the connection
'If Err = 0 Then
' MyRecords.Close
' Exit Function
'End If
' Initialize progress meter.
' ReturnValue = SysCmd(SYSCMD_INITMETER, "Attaching tables",
NumberOfAttachedTables())
' filename = GetMDBName("Change_Database_Connection") '
Display Open File dialog.
' filename = Trim(filename)
' If filename = "" Then GoTo Exit_Change_Database_Connection_Failed
' User pressed Cancel.
' Loop through all tables, reattaching those with nonzero-length
Connect strings.
' DoCmd.Hourglass True
' DoCmd.OpenForm "USysAdvisory"
' [Forms]![USysAdvisory]![Advisory].Caption = "Connecting first
table..."
' [Forms]![USysAdvisory].Repaint
' intTableCount = 0
'' For I = 0 To MyDB.TableDefs.Count - 1
' Set MyTable = MyDB.TableDefs(I)
' If MyTable.Connect <> "" Then
' MyTable.Connect = ";DATABASE=" & filename
' Err = 0
' MyTable.RefreshLink
' intTableCount = intTableCount + 1
' If Err <> 0 Then
' If Err = NONEXISTENT_TABLE Then
' MsgBox "File '" & filename & "' does not contain
required table '" & MyTable.SourceTableName & ".", 16, "Change Database
Connection"
' ElseIf Err = FILE_NOT_FOUND Then
' MsgBox "Database connections not changed.", 16,
"Setup Error"
' ElseIf Err = ACCESS_DENIED Then
' MsgBox "Could not open " & filename & " because it
is read-only or it is located on a read-only share.", 16, "Change
Database Connection"
' ElseIf Err = READ_ONLY_DATABASE Then
' MsgBox "Can not reattach tables because " & filename
& " is read-only or is located on a read-only share.", 16, "Change
Database Connection"
' Else
' MsgBox Error, 16, "Change Database Connection"
' End If
' Change_Database_Connection = False
' GoTo Exit_Change_Database_Connection_Final
' End If
' [Forms]![USysAdvisory]![Advisory].Caption = intTableCount
& " of " & NumberOfAttachedTables() & " table(s) reconnected"
' [Forms]![USysAdvisory].Repaint
' ReturnValue = SysCmd(SYSCMD_UPDATEMETER, intTableCount)
' End If
'Next I
'GoTo Exit_Change_Database_Connection_Final
'Exit_Change_Database_Connection_Failed:
' MsgBox "Database connections not changed.", 16, "Change Database
Connection"
' Change_Database_Connection = False
'Exit_Change_Database_Connection_Final:
' ReturnValue = SysCmd(SYSCMD_REMOVEMETER)
' DoCmd.Close A_FORM, "USysAdvisory"
' DoCmd.Hourglass False
'End Function
'Function GetMDBName(strCallingFunction As String) As String
' Return path of GUEST BILLING DATA.MDB or file chosen by user in
OpenFile dialog box.
' (This function works in conjunction with GetMDBName2 and
StringFromSz to
' display a File-Open dialog that prompts user for location of
NWIND.MDB.
' It uses code found in WZLIB.MDA.)
' Const OFN_SHAREAWARE = &H4000
' Const OFN_PATHMUSTEXIST = &H800
' Const OFN_HIDEREADONLY = &H4
' Dim OFN As WLIB_GETFILENAMEINFO
' Fill ofn structure which is passed to wlib_GetFileName
' OFN.hWndOwner = 0
' OFN.szFilter = "Databases (*.mdb)|*.mdb|All(*.*)|*.*||"
' OFN.nFilterIndex = 1
' Select Case strCallingFunction
' Case "AreTablesAttached"
' OFN.szTitle = "Please indicate the location of Guest
Billing Data.MDB"
' Case "ChangeDBConnection"
' OFN.szTitle = "Please indicate the location of the database"
' Case "Connect_Invoices_DB"
' OFN.szTitle = "Please indicate the location of the DPMS
download database"
' Case Else
' End Select
' OFN.Flags = OFN_SHAREAWARE Or OFN_PATHMUSTEXIST Or OFN_HIDEREADONLY
' OFN.szDefExt = "mdb"
' Call wlib_GetFileName function and interpret results.
' If (GetMDBName2(OFN, True) = False) Then
' GetMDBName = StringFromSz(OFN.szFile)
' Else
' GetMDBName = ""
' End If
'End Function
'Function GetMDBName2(gfni As WLIB_GETFILENAMEINFO, ByVal fOpen As
Integer) As Long
' This function acts as a cover to MSAU_GetFileName in MSAU200.DLL.
' wlib_GetFileName terminates all strings in gfni structure with
nulls and
' then calls DLL version of function. Upon returning from
MSAU200.DLL, null
' characters are removed from strings in gfni.
' Dim lRet As Long
' gfni.szFilter = RTrim$(gfni.szFilter) & Chr$(0)
' gfni.szCustomFilter = RTrim$(gfni.szCustomFilter) & Chr$(0)
' gfni.szFile = RTrim$(gfni.szFile) & Chr$(0)
' gfni.szFileTitle = RTrim$(gfni.szFileTitle) & Chr$(0)
' gfni.szInitialDir = RTrim$(gfni.szInitialDir) & Chr$(0)
' gfni.szTitle = RTrim$(gfni.szTitle) & Chr$(0)
' gfni.szDefExt = RTrim$(gfni.szDefExt) & Chr$(0)
' lRet = wlib_MSAU_GetFileName(gfni, fOpen)
' gfni.szFilter = StringFromSz(gfni.szFilter)
' gfni.szCustomFilter = StringFromSz(gfni.szCustomFilter)
' gfni.szFile = StringFromSz(gfni.szFile)
' gfni.szFileTitle = StringFromSz(gfni.szFileTitle)
' gfni.szInitialDir = StringFromSz(gfni.szInitialDir)
' gfni.szTitle = StringFromSz(gfni.szTitle)
' gfni.szDefExt = StringFromSz(gfni.szDefExt)
' GetMDBName2 = lRet
'End Function
dave said:
I have a front end / back end configured database. All the tables used are
in one back end. Is there an easy way to have the user push a button and
change to a different, identically structured backend? The company will use
the back end is several locations and it is a good segregation to have the
data in separate files. I would like the other locations to be able to email
the backend to the home office and have the person at the home office change
backends with the ease of opening up different excel files.
Thanks for any help,
dave
