Here's some code I happened to have. Not sure where I got it. I have used the code below to automatically reattach tables if the database MDB and data MDB have been moved. This is Access 97 code and works only if the two files are in the same directory.
Function Autoexec()
Dim VerifyPrompt As Variant
Dim Status As Variant
If Not SysCmd(acSysCmdRuntime) Then
Status = AutoReattachTables(VerifyPrompt)
End If
End Function
Function AutoReattachTables(ByVal nVerifyPrompt As Integer)
'
' This function is used to automatically (and with optional
' user verification) reattach tables in databases that have
' been moved from their original location. It makes two very
' important assumptions, which I believe are true about many
' Access databases that are developed:
'
' 1. The main code for the database is in a separate file from
' the tables themselves (otherwise this routine isn't needed).
' It is assumed that the database containing the code is the
' one containing this module, and that it is the current database
' when this routine is called.
' 2. It is assumed that the files containing the code and tables
' are to reside in the same directory.
'
' This routine essentially checks the second condition, and will
' modify the path name pointing to the table database if it doesn't
' match the path of the code (current) database.
'
' This routine is passed one argument: a flag indicating whether the
' user should be prompted for verification if the table database file
' location is going to be updated. The user is giving the option of
' allowing the update (Yes), or skipping it (No). If "No" is selected,
' no change is made, and the tables will be accessed in the original
' directories. If the verification flag is false, the update is done
' unconditionally.
'
' If the user verification option is enabled, the user is only prompted
' on the first table to be updated. Subsequent tables are handled in
' the same manner as the first. This prevents a large number of prompts
' when many tables are attached. A more robust solution would be to use
' "Yes", "Yes to All", "No", and "Cancel" as the options, but the standard
' message box does not allow this, and I didn't want to create a special
' form for this routine.
'
' This routine can be called from the AutoExec macro, and the user
' verification flag can be set to true or false as desired.
'
' This function returns True (-1) if it succeded or False (0) if there
' were any errors. Unexpected errors may also display a message box.
'
' NOTE: This routine currently only works with attached Access tables,
' but could be modified for other table types (the code to strip off
' the .MDB file name from the database path would need to be smarter).
'
On Error GoTo AutoReattachTables_Err
Dim MainDBDir As String ' Path of database containing code
Dim db As Database ' Current database object
Dim TabDefs As TableDefs ' TableDefs collection
Dim nCurTab As Integer ' Counter for cycling through tables
Dim nPtr As Integer ' Temporary string pointer
Dim TabFileNameLoc As String ' Path of current table DB file
Dim TabFileName As String ' DB file name for current table
Dim nConnectLen As Integer ' Length of Connect property value
Dim ConnectPrefix As String ' beginning of Connect property value
Dim nDBDirPos As Integer ' String pointer
Dim PromptStr As String ' User verification prompt message
Dim nPromptDone As Integer ' Flag for prompting user only once
Dim nYesToAll As Integer ' User response to verification prompt
Set db = DBEngine.Workspaces(0).Databases(0) ' Point to current database
Set TabDefs = db.TableDefs ' open the TableDefs collection
MainDBDir = db.Name ' get full path of code database
For nPtr = Len(MainDBDir) To 1 Step -1 ' find last backslash to strip file name
If Mid$(MainDBDir, nPtr, 1) = "\" Then
MainDBDir = Left$(MainDBDir, nPtr - 1) ' extract path
Exit For
End If
Next
If MainDBDir = "" Then
AutoReattachTables = False ' function failed
Exit Function
End If
' check each table in database
nPromptDone = False ' we haven't prompted user yet
' the next statement initializes the default update action to True if the
' verification prompt is disabled (otherwise, we assume user will say "No"
nYesToAll = Not nVerifyPrompt
For nCurTab = 0 To TabDefs.Count - 1
If Mid(TabDefs(nCurTab).Name, 1, 4) <> "MSys" Then ' ignore system tables
TabFileNameLoc = TabDefs(nCurTab).Connect ' get path to DB dir/file
nConnectLen = Len(TabFileNameLoc) ' length of connect string
For nPtr = nConnectLen To 1 Step -1 ' search for last backslash
If Mid$(TabFileNameLoc, nPtr, 1) = "\" Then ' if found, get table file name
TabFileName = Right(TabFileNameLoc, nConnectLen - nPtr)
TabFileNameLoc = Left$(TabFileNameLoc, nPtr - 1)
Exit For
End If
Next
nDBDirPos = InStr(TabFileNameLoc, "DATABASE="
' find prefix to path name
If nDBDirPos Then ' if we found start of path
nDBDirPos = nDBDirPos + 9 ' Len("DATABASE="
' point past prefix
ConnectPrefix = Left$(TabFileNameLoc, nDBDirPos - 1) ' save prefix for later
TabFileNameLoc = Right(TabFileNameLoc, Len(TabFileNameLoc) - nDBDirPos + 1)
If TabFileNameLoc <> MainDBDir Then ' directories don't match
If nVerifyPrompt And (Not nPromptDone) Then ' see if we check with user
' based on the assumptions discussed in the comments
' at the start of this routine, this function words the
' following message accordingly
PromptStr = "Database file " & TabFileName & " has been moved" & Chr$(10) & Chr$(13)
PromptStr = PromptStr & "from directory: " & TabFileNameLoc & Chr$(10) & Chr$(13)
PromptStr = PromptStr & "to directory: " & MainDBDir & Chr$(10) & Chr$(13) & Chr$(13)
PromptStr = PromptStr & "Would you like the directory location updated for" & Chr$(10) & Chr$(13)
PromptStr = PromptStr & "this and any other database files that have been moved?"
If MsgBox(PromptStr, 4) = 6 Then ' get the response
nYesToAll = True ' if "Yes", set flag to update
End If
nPromptDone = True
End If
If nYesToAll Then ' if we're to update...
' this is the easy part - construct new path name and force a refresh
TabDefs(nCurTab).Connect = ConnectPrefix & MainDBDir & "\" & TabFileName
TabDefs(nCurTab).RefreshLink
End If
End If
End If
End If
Next
AutoReattachTables = True ' function succeeded
AutoReattachTables_Exit:
Exit Function
AutoReattachTables_Err:
Dim ErrMsg As String
ErrMsg = "AutoReattachTables: " & Error$
If TabFileName <> "" Then ErrMsg = ErrMsg & " (" & TabFileName & "
"
MsgBox ErrMsg
Resume AutoReattachTables_Exit
End Function
An old PICKer, using Access2000. I manage 