Looking for auto re-link code

[josephbupe]

Hi,

I have split my mdb database and I want to have them distributed to various remote place where there would be no network. The FE and BE will be in the same folder.

What I need is a code that should re-link the BE. Tried to search this forum but could not find exact solution.

I will appreciate any help.

Joseph

 

[namliam]

See if this gets you started

 

[josephbupe]

Hi Namliam,

Thanx for the code. I will try it out.

Regards.

Joseph

 

[josephbupe]

Please, I need help to figure out what am missing. The original code here is inteded to re-link tables to the front end automatically if both the FE and BE are in the same folder. Am trying to adopt the code for my use but am only ending up in the error "No table database has been found ..."

Private Sub Form_Open(Cancel As Integer)
    Dim tbl As TableDef
    Dim x As Long, MaxX As Long
    Dim tblDB As String
    Me.Visible = False
    tblDB = myFolder & "ZP_Contacts\ZP_Contacts_BE.MDB"
    If Dir(tblDB) = "" Then
        MsgBox "No table database has been found, " & vbCr & vbCr & _
                "This application will not work, so its beeing closed", vbCritical
        Application.Quit
    End If
                       
    MaxX = 1 ' first count all attached tables
    For Each tbl In CurrentDb.TableDefs()
        If tbl.Attributes = dbAttachedTable Then MaxX = MaxX + 1
    Next tbl
    x = 1 ' Now update them
    For Each tbl In CurrentDb.TableDefs()
        If tbl.Attributes = dbAttachedTable Then
            tblDB = myFolder & Mid(tbl.Connect, InStr(1, tbl.Connect, "ZP_Contacts 22-08-2010\"))
            If tbl.Connect <> ";Database=" & tblDB Then
                Me.Visible = True
                Me.Repaint
                tbl.Connect = ";Database=" & tblDB
                tbl.RefreshLink
            End If
            x = x + 1
        End If
        Me.Fill.Width = x / MaxX * Me.FillTo.Width
    Next tbl
    If Me.Visible Then
        Me.lblWait.Caption = "Done relinking ... "
        Me.Repaint
        MaxX = Timer + 2
        Do While Timer <= MaxX
        Loop
    End If
    
    DoCmd.OpenForm "frmMain"
    DoCmd.Close acForm, Me.Name
    
End Sub
Function myFolder()
    myFolder = Left(CurrentDb.Name, InStrRev(CurrentDb.Name, "\"))
End Function

My database name is = ZP_Contacts_v5_2010_08_22
My back end file is = ZP_Contacts_BE
My folder name is = ZP_Contacts
I will appreciate you help.
Joseph

 

[Rabbie]

I would try setting a breakpoint before you output the error message so you can check what tblDB is set to. then you can be sure you are looking in the correct folder.

It may also be worthwhile changing the line

tblDB = myFolder & "ZP_Contacts\ZP_Contacts_BE.MDB"

to

tblDB = myFolder & "ZP_Contacts_BE.MDB"


Good luck

 

[namliam]

To get the original code working for the same folder you simply have to remove all the (sub)folder stuff:
tblDB = myFolder & "Folder\Database.MDB"
to: tblDB = myFolder & "Database.MDB"
tblDB = myFolder & Mid(tbl.Connect, InStr(1, tbl.Connect, "Folder\"))
to: tblDB = myFolder

You will also need a form to contain it in that has 2 same size rectangles, named Fill and FillTo

As well as a label called lblWait