Relinking Tables with VBA code

[online.experiment]

Hello together,

I got this wonderful code from the internet to relink all tables from
a backend database in the same folder.
Unfortunatelly its not working: The code gets me the right folder (see
MsgBox (strPath) but after that it links only the first table but not
the others.

Can anybody tell me what's wrong in the code?

Thank you very much!!!

Andreas

Function link()
On Error GoTo MyError

Dim db As DAO.Database
Dim strPath As String
Dim i As Integer

Set db = CurrentDb()

strPath = Left(db.Name, Len(db.Name) - Len(Dir(db.Name))) &
"social_performance_be.mdb"
MsgBox (strPath)
MsgBox (db.TableDefs.Count)

For i = 0 To db.TableDefs.Count - 1
If db.TableDefs(i).Connect <> "" Then
If Mid(db.TableDefs(i).Connect, 11) <> strPath Then
db.TableDefs(i).Connect = ";database=" & strPath
db.TableDefs(i).RefreshLink
End If
End If
Next i
MsgBox ("all ok")

MyExit:
Exit Function

MyError:
MsgBox "Error during linking. ", 16, "Ausnahme"
Resume MyExit
End Function

 

[Arvin Meyer [MVP]]

Try this code. It has been working for us for 10 years:

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

 

[online.experiment]

Hi Arvin,
thanks a lot! Its great but I dont want to bother the user with
searching the backend. Usually the backend is always in the same
directory as the frontend.
Sorry, but I did a little bit in VBA, but not very much. Is it easily
possible to alter the code that it only looks in the directory where
the front end is (the db where I am running the code)?

Thanks a lot,

Andreas

 

[Douglas J. Steele]

If you don't want to prompt the user, replace

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

with

strNewPath = Left(db.Name, Len(db.Name) - Len(Dir(db.Name))) & _
"social_performance_be.mdb"

 

[online.experiment]

Hi Doug,

great, fantastic! You saved me a lot of work and some grey hair ;-)

It works fantastic!

Thank you very much,

Andreas
Ps: I only had to rename "db" to "dbCurr"