> http://www.mvps.org/access/tables/tbl0009.htm

> Now the code looks to work until I uncomment out the code for the ODBC
> tables. What I need to do is when a user installs the database is for them
> to have a setup window that creates the DSN's and Relinks the tables that
I
> have in the database to their database. The names of the tables will be
the
> same so I just need to relink the data. I have a screen that will create
the
> DSN from items that they select where the data is and a few other Items.
How
> can I get this code to work? I'm at a loss. The code stops at a .connect =
> pcConnect I can't find what pcConnect is. Has anyone used this code
before?

> Thanks
> Allen
> Code;
> Option Compare Database
> Option Explicit
> '***************** Code Start ***************
> Function fRefreshLinks() As Boolean
> Dim strMsg As String, collTbls As Collection
> Dim i As Integer, strDBPath As String, strTbl As String
> Dim dbCurr As Database, dbLink As Database
> Dim tdfLocal As TableDef
> Dim varRet As Variant
> Dim strNewPath As String

> Const cERR_USERCANCEL = vbObjectError + 1000
> Const cERR_NOREMOTETABLE = vbObjectError + 2000

>     On Local Error GoTo fRefreshLinks_Err

>     If Msgbox("Are you sure you want to reconnect all Access tables?", _
>             vbQuestion + vbYesNo, "Please confirm...") = vbNo Then
> Err.RaisecERR_USERCANCEL

>     'First get all linked tables in a collection
>     Set collTbls = fGetLinkedTables

>     'now link all of them
>     Set dbCurr = CurrentDb

>   strMsg = "Do you wish to specify a different path for the Access
Tables?"
> If Msgbox(strMsg, vbQuestion + vbYesNo, "Alternate data source...") =
vbYes
> Then
>  strNewPath = fGetMDBName("Please select a new datasource")
>  Else
> strNewPath = vbNullString
> End If

>     For i = collTbls.Count To 1 Step -1
>         strDBPath = fParsePath(collTbls(i))
>         strTbl = fParseTable(collTbls(i))
>         varRet = SysCmd(acSysCmdSetStatus, "Now linking '" & strTbl &
> "'....")
>         If Left$(strDBPath, 4) = "ODBC" Then
>             'ODBC Tables
>             'ODBC Tables handled separately
>             Set tdfLocal = dbCurr.TableDefs(strTbl)
>             With tdfLocal
>                 .Connect = pcCONNECT
>                 .RefreshLink
>                 .collTbls.Remove (strTbl)
>             End With
>         Else
>             If strNewPath <> vbNullString Then
>                 'Try this first
>                 strDBPath = strNewPath
>             Else
>                 If Len(Dir(strDBPath)) = 0 Then
>                     'File Doesn't Exist, call GetOpenFileName
>                     strDBPath = fGetMDBName("'" & strDBPath & "' not
> found.")
>                     If strDBPath = vbNullString Then
>                         'user pressed cancel
>                         Err.Raise cERR_USERCANCEL
>                     End If
>                 End If
>             End If

>             'backend database exists
>             'putting it here since we could have
>             'tables from multiple sources
>             Set dbLink = DBEngine(0).OpenDatabase(strDBPath)

>             'check to see if the table is present in dbLink
>             strTbl = fParseTable(collTbls(i))
>             If fIsRemoteTable(dbLink, strTbl) Then
>                 'everything's ok, reconnect
>                 Set tdfLocal = dbCurr.TableDefs(strTbl)
>                 With tdfLocal
>                     .Connect = ";Database=" & strDBPath
>                     .RefreshLink
>                     collTbls.Remove (.Name)
>                 End With
>             Else
>                 Err.Raise cERR_NOREMOTETABLE
>             End If
>         End If
>     Next
>     fRefreshLinks = True
>     varRet = SysCmd(acSysCmdClearStatus)
>     Msgbox "All Access tables were successfully reconnected.",
vbInformation
> + vbOKOnly, "Success"
> fRefreshLinks_End:
>     Set collTbls = Nothing
>     Set tdfLocal = Nothing
>     Set dbLink = Nothing
>     Set dbCurr = Nothing
>     Exit Function
> fRefreshLinks_Err:
>     fRefreshLinks = False
>     Select Case Err
>         Case 3059:

>         Case cERR_USERCANCEL:
>             Msgbox "No Database was specified, couldn't link tables.", _
>                     vbCritical + vbOKOnly, _
>                     "Error in refreshing links."
>             Resume fRefreshLinks_End
>         Case cERR_NOREMOTETABLE:
>             Msgbox "Table '" & strTbl & "' was not found in the database"
&
> _
>                     vbCrLf & dbLink.Name & ". Couldn't refresh links", _
>                     vbCritical + vbOKOnly, _
>                     "Error in refreshing links."
>             Resume fRefreshLinks_End
>         Case Else:
>             strMsg = "Error Information..." & vbCrLf & vbCrLf
>             strMsg = strMsg & "Function: fRefreshLinks" & vbCrLf
>             strMsg = strMsg & "Description: " & Err.Description & vbCrLf
>             strMsg = strMsg & "Error #: " & Format$(Err.Number) & vbCrLf
>             Msgbox strMsg, vbOKOnly + vbCritical, "Error"
>             Resume fRefreshLinks_End
>     End Select
> End Function

> Function fIsRemoteTable(dbRemote As Database, strTbl As String) As Boolean
> Dim tdf As TableDef
>     On Error Resume Next
>     Set tdf = dbRemote.TableDefs(strTbl)
>     fIsRemoteTable = (Err = 0)
>     Set tdf = Nothing
> End Function

> Function fGetMDBName(strIn As String) As String
> 'Calls GetOpenFileName dialog
> Dim strFilter As String

>     strFilter = ahtAddFilterItem(strFilter, _
>                     "Access Database(*.mdb;*.mda;*.mde;*.mdw) ", _
>                     "*.mdb; *.mda; *.mde; *.mdw")
>     strFilter = ahtAddFilterItem(strFilter, _
>                     "All Files (*.*)", _
>                     "*.*")

>     fGetMDBName = ahtCommonFileOpenSave(Filter:=strFilter, _
>                                 OpenFile:=True, _
>                                 DialogTitle:=strIn, _
>                                 Flags:=ahtOFN_HIDEREADONLY)
> End Function

> Function fGetLinkedTables() As Collection
> 'Returns all linked tables
>     Dim collTables As New Collection
>     Dim tdf As TableDef, db As Database
>     Set db = CurrentDb
>     db.TableDefs.Refresh
>     For Each tdf In db.TableDefs
>         With tdf
>             If Len(.Connect) > 0 Then
>                 If Left$(.Connect, 4) = "ODBC" Then
>                     collTables.Add Item:=.Name & ";" & .Connect,
KEY:=.Name
>                 'ODBC Reconnect handled separately
>                 Else
>                     collTables.Add Item:=.Name & .Connect, KEY:=.Name
>                 End If
>             End If
>         End With
>     Next
>     Set fGetLinkedTables = collTables
>     Set collTables = Nothing
>     Set tdf = Nothing
>     Set db = Nothing
> End Function

> Function fParsePath(strIn As String) As String
>     If Left$(strIn, 4) <> "ODBC" Then
>         fParsePath = Right(strIn, Len(strIn) _
>                         - (InStr(1, strIn, "DATABASE=") + 8))
>     Else
>         fParsePath = strIn
>     End If
> End Function

> Function fParseTable(strIn As String) As String
>     fParseTable = Left$(strIn, InStr(1, strIn, ";") - 1)
> End Function
> '***************** Code End ***************

> I have used basically the same coed, but not with an ODBC database. I
> believe the code firs appeared in "Access 97 Developer's Handbook" by
> Llitwin Getz, and Gilbert.

> In a direct access linked Access 97 table the Connect property is:
> ";Database= " & strPath & strDatabaseName.

> You need to find out what the connect property is for an ODBC database. This
> should be available from MS on-line help, I would think.

> By the way, this code will only work for Access 97, Access 2000 uses ADO, so
> the code must be rewritten to use ADO instead od DAO.

> Ragnar

> > http://www.mvps.org/access/tables/tbl0009.htm

> > Now the code looks to work until I uncomment out the code for the ODBC
> > tables. What I need to do is when a user installs the database is for them
> > to have a setup window that creates the DSN's and Relinks the tables that
> I
> > have in the database to their database. The names of the tables will be
> the
> > same so I just need to relink the data. I have a screen that will create
> the
> > DSN from items that they select where the data is and a few other Items.
> How
> > can I get this code to work? I'm at a loss. The code stops at a .connect =
> > pcConnect I can't find what pcConnect is. Has anyone used this code
> before?

> > Thanks
> > Allen
> > Code;
> > Option Compare Database
> > Option Explicit
> > '***************** Code Start ***************
> > Function fRefreshLinks() As Boolean
> > Dim strMsg As String, collTbls As Collection
> > Dim i As Integer, strDBPath As String, strTbl As String
> > Dim dbCurr As Database, dbLink As Database
> > Dim tdfLocal As TableDef
> > Dim varRet As Variant
> > Dim strNewPath As String

> > Const cERR_USERCANCEL = vbObjectError + 1000
> > Const cERR_NOREMOTETABLE = vbObjectError + 2000

> >     On Local Error GoTo fRefreshLinks_Err

> >     If Msgbox("Are you sure you want to reconnect all Access tables?", _
> >             vbQuestion + vbYesNo, "Please confirm...") = vbNo Then
> > Err.RaisecERR_USERCANCEL

> >     'First get all linked tables in a collection
> >     Set collTbls = fGetLinkedTables

> >     'now link all of them
> >     Set dbCurr = CurrentDb

> >   strMsg = "Do you wish to specify a different path for the Access
> Tables?"
> > If Msgbox(strMsg, vbQuestion + vbYesNo, "Alternate data source...") =
> vbYes
> > Then
> >  strNewPath = fGetMDBName("Please select a new datasource")
> >  Else
> > strNewPath = vbNullString
> > End If

> >     For i = collTbls.Count To 1 Step -1
> >         strDBPath = fParsePath(collTbls(i))
> >         strTbl = fParseTable(collTbls(i))
> >         varRet = SysCmd(acSysCmdSetStatus, "Now linking '" & strTbl &
> > "'....")
> >         If Left$(strDBPath, 4) = "ODBC" Then
> >             'ODBC Tables
> >             'ODBC Tables handled separately
> >             Set tdfLocal = dbCurr.TableDefs(strTbl)
> >             With tdfLocal
> >                 .Connect = pcCONNECT
> >                 .RefreshLink
> >                 .collTbls.Remove (strTbl)
> >             End With
> >         Else
> >             If strNewPath <> vbNullString Then
> >                 'Try this first
> >                 strDBPath = strNewPath
> >             Else
> >                 If Len(Dir(strDBPath)) = 0 Then
> >                     'File Doesn't Exist, call GetOpenFileName
> >                     strDBPath = fGetMDBName("'" & strDBPath & "' not
> > found.")
> >                     If strDBPath = vbNullString Then
> >                         'user pressed cancel
> >                         Err.Raise cERR_USERCANCEL
> >                     End If
> >                 End If
> >             End If

> >             'backend database exists
> >             'putting it here since we could have
> >             'tables from multiple sources
> >             Set dbLink = DBEngine(0).OpenDatabase(strDBPath)

> >             'check to see if the table is present in dbLink
> >             strTbl = fParseTable(collTbls(i))
> >             If fIsRemoteTable(dbLink, strTbl) Then
> >                 'everything's ok, reconnect
> >                 Set tdfLocal = dbCurr.TableDefs(strTbl)
> >                 With tdfLocal
> >                     .Connect = ";Database=" & strDBPath
> >                     .RefreshLink
> >                     collTbls.Remove (.Name)
> >                 End With
> >             Else
> >                 Err.Raise cERR_NOREMOTETABLE
> >             End If
> >         End If
> >     Next
> >     fRefreshLinks = True
> >     varRet = SysCmd(acSysCmdClearStatus)
> >     Msgbox "All Access tables were successfully reconnected.",
> vbInformation
> > + vbOKOnly, "Success"
> > fRefreshLinks_End:
> >     Set collTbls = Nothing
> >     Set tdfLocal = Nothing
> >     Set dbLink = Nothing
> >     Set dbCurr = Nothing
> >     Exit Function
> > fRefreshLinks_Err:
> >     fRefreshLinks = False
> >     Select Case Err
> >         Case 3059:

> >         Case cERR_USERCANCEL:
> >             Msgbox "No Database was specified, couldn't link tables.", _
> >                     vbCritical + vbOKOnly, _
> >                     "Error in refreshing links."
> >             Resume fRefreshLinks_End
> >         Case cERR_NOREMOTETABLE:
> >             Msgbox "Table '" & strTbl & "' was not found in the database"
> &
> > _
> >                     vbCrLf & dbLink.Name & ". Couldn't refresh links", _
> >                     vbCritical + vbOKOnly, _
> >                     "Error in refreshing links."
> >             Resume fRefreshLinks_End
> >         Case Else:
> >             strMsg = "Error Information..." & vbCrLf & vbCrLf
> >             strMsg = strMsg & "Function: fRefreshLinks" & vbCrLf
> >             strMsg = strMsg & "Description: " & Err.Description & vbCrLf
> >             strMsg = strMsg & "Error #: " & Format$(Err.Number) & vbCrLf
> >             Msgbox strMsg, vbOKOnly + vbCritical, "Error"
> >             Resume fRefreshLinks_End
> >     End Select
> > End Function

> > Function fIsRemoteTable(dbRemote As Database, strTbl As String) As Boolean
> > Dim tdf As TableDef
> >     On Error Resume Next
> >     Set tdf = dbRemote.TableDefs(strTbl)
> >     fIsRemoteTable = (Err = 0)
> >     Set tdf = Nothing
> > End Function

> > Function fGetMDBName(strIn As String) As String
> > 'Calls GetOpenFileName dialog
> > Dim strFilter As String

> >     strFilter = ahtAddFilterItem(strFilter, _
> >                     "Access Database(*.mdb;*.mda;*.mde;*.mdw) ", _
> >                     "*.mdb; *.mda; *.mde; *.mdw")
> >     strFilter = ahtAddFilterItem(strFilter, _
> >                     "All Files (*.*)", _
> >                     "*.*")

> >     fGetMDBName = ahtCommonFileOpenSave(Filter:=strFilter, _
> >                                 OpenFile:=True, _
> >                                 DialogTitle:=strIn, _
> >                                 Flags:=ahtOFN_HIDEREADONLY)
> > End Function

> > Function fGetLinkedTables() As Collection
> > 'Returns all linked tables
> >     Dim collTables As New Collection
> >     Dim tdf As TableDef, db As Database
> >     Set db = CurrentDb
> >     db.TableDefs.Refresh
> >     For Each tdf In db.TableDefs
> >         With tdf
> >             If Len(.Connect) > 0 Then
> >                 If Left$(.Connect, 4) = "ODBC" Then
> >                     collTables.Add Item:=.Name & ";" & .Connect,
> KEY:=.Name
> >                 'ODBC Reconnect handled separately
> >                 Else
> >                     collTables.Add Item:=.Name & .Connect, KEY:=.Name
> >                 End If
> >             End If
> >         End With
> >     Next
> >     Set fGetLinkedTables = collTables
> >     Set collTables = Nothing
> >     Set tdf = Nothing
> >     Set db = Nothing
> > End Function

> > Function fParsePath(strIn As String) As String
> >     If Left$(strIn, 4) <> "ODBC" Then
> >         fParsePath = Right(strIn, Len(strIn) _
> >                         - (InStr(1, strIn, "DATABASE=") + 8))
> >     Else
> >         fParsePath = strIn
> >     End If
> > End Function

> > Function fParseTable(strIn As String) As String
> >     fParseTable = Left$(strIn, InStr(1, strIn, ";") - 1)
> > End Function
> > '***************** Code End ***************

> I have used basically the same coed, but not with an ODBC database. I
> believe the code firs appeared in "Access 97 Developer's Handbook" by
> Llitwin Getz, and Gilbert.

> In a direct access linked Access 97 table the Connect property is:
> ";Database= " & strPath & strDatabaseName.

> You need to find out what the connect property is for an ODBC database.
This
> should be available from MS on-line help, I would think.

> By the way, this code will only work for Access 97, Access 2000 uses ADO,
so
> the code must be rewritten to use ADO instead od DAO.

> Ragnar

> > http://www.mvps.org/access/tables/tbl0009.htm

> > Now the code looks to work until I uncomment out the code for the ODBC
> > tables. What I need to do is when a user installs the database is for
them
> > to have a setup window that creates the DSN's and Relinks the tables
that
> I
> > have in the database to their database. The names of the tables will be
> the
> > same so I just need to relink the data. I have a screen that will create
> the
> > DSN from items that they select where the data is and a few other Items.
> How
> > can I get this code to work? I'm at a loss. The code stops at a .connect
=
> > pcConnect I can't find what pcConnect is. Has anyone used this code
> before?

> > Thanks
> > Allen
> > Code;
> > Option Compare Database
> > Option Explicit
> > '***************** Code Start ***************
> > Function fRefreshLinks() As Boolean
> > Dim strMsg As String, collTbls As Collection
> > Dim i As Integer, strDBPath As String, strTbl As String
> > Dim dbCurr As Database, dbLink As Database
> > Dim tdfLocal As TableDef
> > Dim varRet As Variant
> > Dim strNewPath As String

> > Const cERR_USERCANCEL = vbObjectError + 1000
> > Const cERR_NOREMOTETABLE = vbObjectError + 2000

> >     On Local Error GoTo fRefreshLinks_Err

> >     If Msgbox("Are you sure you want to reconnect all Access tables?", _
> >             vbQuestion + vbYesNo, "Please confirm...") = vbNo Then
> > Err.RaisecERR_USERCANCEL

> >     'First get all linked tables in a collection
> >     Set collTbls = fGetLinkedTables

> >     'now link all of them
> >     Set dbCurr = CurrentDb

> >   strMsg = "Do you wish to specify a different path for the Access
> Tables?"
> > If Msgbox(strMsg, vbQuestion + vbYesNo, "Alternate data source...") =
> vbYes
> > Then
> >  strNewPath = fGetMDBName("Please select a new datasource")
> >  Else
> > strNewPath = vbNullString
> > End If

> >     For i = collTbls.Count To 1 Step -1
> >         strDBPath = fParsePath(collTbls(i))
> >         strTbl = fParseTable(collTbls(i))
> >         varRet = SysCmd(acSysCmdSetStatus, "Now linking '" & strTbl &
> > "'....")
> >         If Left$(strDBPath, 4) = "ODBC" Then
> >             'ODBC Tables
> >             'ODBC Tables handled separately
> >             Set tdfLocal = dbCurr.TableDefs(strTbl)
> >             With tdfLocal
> >                 .Connect = pcCONNECT
> >                 .RefreshLink
> >                 .collTbls.Remove (strTbl)
> >             End With
> >         Else
> >             If strNewPath <> vbNullString Then
> >                 'Try this first
> >                 strDBPath = strNewPath
> >             Else
> >                 If Len(Dir(strDBPath)) = 0 Then
> >                     'File Doesn't Exist, call GetOpenFileName
> >                     strDBPath = fGetMDBName("'" & strDBPath & "' not
> > found.")
> >                     If strDBPath = vbNullString Then
> >                         'user pressed cancel
> >                         Err.Raise cERR_USERCANCEL
> >                     End If
> >                 End If
> >             End If

> >             'backend database exists
> >             'putting it here since we could have
> >             'tables from multiple sources
> >             Set dbLink = DBEngine(0).OpenDatabase(strDBPath)

> >             'check to see if the table is present in dbLink
> >             strTbl = fParseTable(collTbls(i))
> >             If fIsRemoteTable(dbLink, strTbl) Then
> >                 'everything's ok, reconnect
> >                 Set tdfLocal = dbCurr.TableDefs(strTbl)
> >                 With tdfLocal
> >                     .Connect = ";Database=" & strDBPath
> >                     .RefreshLink
> >                     collTbls.Remove (.Name)
> >                 End With
> >             Else
> >                 Err.Raise cERR_NOREMOTETABLE
> >             End If
> >         End If
> >     Next
> >     fRefreshLinks = True
> >     varRet = SysCmd(acSysCmdClearStatus)
> >     Msgbox "All Access tables were successfully reconnected.",
> vbInformation
> > + vbOKOnly, "Success"
> > fRefreshLinks_End:
> >     Set collTbls = Nothing
> >     Set tdfLocal = Nothing
> >     Set dbLink = Nothing
> >     Set dbCurr = Nothing
> >     Exit Function
> > fRefreshLinks_Err:
> >     fRefreshLinks = False
> >     Select Case Err
> >         Case 3059:

> >         Case cERR_USERCANCEL:
> >             Msgbox "No Database was specified, couldn't link tables.", _
> >                     vbCritical + vbOKOnly, _
> >                     "Error in refreshing links."
> >             Resume fRefreshLinks_End
> >         Case cERR_NOREMOTETABLE:
> >             Msgbox "Table '" & strTbl & "' was not found in the
database"
> &
> > _
> >                     vbCrLf & dbLink.Name & ". Couldn't refresh links", _
> >                     vbCritical + vbOKOnly, _
> >                     "Error in refreshing links."
> >             Resume fRefreshLinks_End
> >         Case Else:
> >             strMsg = "Error Information..." & vbCrLf & vbCrLf
> >             strMsg = strMsg & "Function: fRefreshLinks" & vbCrLf
> >             strMsg = strMsg & "Description: " & Err.Description & vbCrLf
> >             strMsg = strMsg & "Error #: " & Format$(Err.Number) & vbCrLf
> >             Msgbox strMsg, vbOKOnly + vbCritical, "Error"
> >             Resume fRefreshLinks_End
> >     End Select
> > End Function

> > Function fIsRemoteTable(dbRemote As Database, strTbl As String) As
Boolean
> > Dim tdf As TableDef
> >     On Error Resume Next
> >     Set tdf = dbRemote.TableDefs(strTbl)
> >     fIsRemoteTable = (Err = 0)
> >     Set tdf = Nothing
> > End Function

> > Function fGetMDBName(strIn As String) As String
> > 'Calls GetOpenFileName dialog
> > Dim strFilter As String

> >     strFilter = ahtAddFilterItem(strFilter, _
> >                     "Access Database(*.mdb;*.mda;*.mde;*.mdw) ", _
> >                     "*.mdb; *.mda; *.mde; *.mdw")
> >     strFilter = ahtAddFilterItem(strFilter, _
> >                     "All Files (*.*)", _
> >                     "*.*")

> >     fGetMDBName = ahtCommonFileOpenSave(Filter:=strFilter, _
> >                                 OpenFile:=True, _
> >                                 DialogTitle:=strIn, _
> >                                 Flags:=ahtOFN_HIDEREADONLY)
> > End Function

> > Function fGetLinkedTables() As Collection
> > 'Returns all linked tables
> >     Dim collTables As New Collection
> >     Dim tdf As TableDef, db As Database
> >     Set db = CurrentDb
> >     db.TableDefs.Refresh
> >     For Each tdf In db.TableDefs
> >         With tdf
> >             If Len(.Connect) > 0 Then
> >                 If Left$(.Connect, 4) = "ODBC" Then
> >                     collTables.Add Item:=.Name & ";" & .Connect,
> KEY:=.Name
> >                 'ODBC Reconnect handled separately
> >                 Else
> >                     collTables.Add Item:=.Name & .Connect, KEY:=.Name
> >                 End If
> >             End If
> >         End With
> >     Next
> >     Set fGetLinkedTables = collTables
> >     Set collTables = Nothing
> >     Set tdf = Nothing
> >     Set db = Nothing
> > End Function

> > Function fParsePath(strIn As String) As String
> >     If Left$(strIn, 4) <> "ODBC" Then
> >         fParsePath = Right(strIn, Len(strIn) _
> >                         - (InStr(1, strIn, "DATABASE=") + 8))
> >     Else
> >         fParsePath = strIn
> >     End If
> > End Function

> > Function fParseTable(strIn As String) As String
> >     fParseTable = Left$(strIn, InStr(1, strIn, ";") - 1)
> > End Function
> > '***************** Code End ***************