VBA form that relinks tables

[Neilster]

Hi All

I have a database which is slpit both frontend and backend. Multi users have the frontend on their desktop and the back end is shared on a network.

The network location may change from time to time, therefore if this happends is it possible to create a form on start up that prompts the user to find the loctaion of the back end using VBA.

Hope this makes sense.

 

[arnelgp]

you can google for a ms access vba relinker

 

[Neilster]

I've looked every where on Google and have only come up with this peace of code, where would it sit ?

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, ""
Resume MyExit

End Function

 

[arnelgp]

put the code in a module.
run LocateBE on your opening form, or in Autoexec macro.

Public Function DirPicker(Optional ByVal strWindowTitle As String = "Select the folder where Backend is located") As String
    Dim fd As Office.FileDialog
    Set fd = Application.FileDialog(msoFileDialogFolderPicker)
    
    fd.title = strWindowTitle
    If fd.Show = -1 Then
        DirPicker = fd.SelectedItems(1)
    Else
        DirPicker = vbNullString
    End If
    Set fd = Nothing
End Function


Public Sub LocateBE()
    Dim rs As DAO.RecordSet
    Dim td As DAO.TableDef
    Dim db As DAO.Database
    Set db = CurrentDB
On Error Resume Next
    For Each td In db.TableDefs
        If Instr(td.Name, "~") = 0 Then
            If Instr(td.Connect, ";DATABASE")<> 0 Then
                set rs = db.OpenRecordset(td.Name)
                Exit For
            End If
        End If
    Next
    Set rs=Nothing
    Set td=nothing
    set db=nothing
    If Err.Number <> 0 Then
        Call ReLink
    End If
End Sub


Public Sub Relink()
On Error GoTo MyError

Dim db As DAO.Database
Dim strPath As String
dim td As DAO.TableDef

strPath = DirPicker()
If strPath <> "" Then
Set db = CurrentDb()

for each td in db.TableDefs
If Instr(td.Connect, ";DATABASE")<> 0 Then
TD.Connect = ";DATABASE=" & strPath & "\"  & mid(td.Connect, InstrRev(td.Connect,"\")+1)
End If
Next 

MyExit:
SET td=nothing
set db=nothing
Exit Sub

MyError:
MsgBox "Error during linking. ", 16, ""
Resume MyExit
End If
End Sub

 

[Neilster]

Thanks for that, however when is start the DB it just says can't find the file path and then when I OK it just goes to a blank database?

 

[Neilster]

I'm using

Call LocateBE(0)

on the open event of the form.

 

[arnelgp]

your form should not have any recordsource. there is no parameter for the sub:

Call LocateBE

 

[Neilster]

Ahh silly me! Thanks for all your help works a treat.

 

[Neilster]

The issue i have now is that the file loctor box opens and you cannot find the BE database anywhere it dosen't allow you to select any Access database format??

 

[speakers_86]

Just use the JStreetRelinker. I've used it for years. Also, why would the path of the backend change?

 

[Neilster]

Whats JStreetRelinker?

 

[speakers_86]

http://www.jstreettech.com/downloads.aspx

 

[cyanidem]

What's Google?

 

[speakers_86]

http://lmgtfy.com/?q=JStreetRelinker

 

[arnelgp]

you said in your first post that the location of the BE changes often, but not the name of the BE, just point to the folder where the db resides, and the code will take care of the rest.

 

[Neilster]

OK this is the code I now have, it opens the location selector and I can now find the DB, I've tested it on different network locations. it will only ever work when you relocate it to the first location when you do the split in access, if it's on a different location then it says it can't find the database.

Public Function DirPicker(Optional ByVal strWindowTitle As String = "Select location") As String

Dim fd As FileDialog
Set fd = Application.FileDialog(msoFileDialogOpen)
With fd
.AllowMultiSelect = True
.Title = "Please select database location"
If .Show = True Then
SelectFile = .SelectedItems(1)
For Each varFile In .SelectedItems

Next

Else
Exit Function
End If
Set fd = Nothing
End With

End Function


Public Sub LocateBE()
Dim rs As DAO.Recordset
Dim td As DAO.TableDef
Dim db As DAO.Database
Set db = CurrentDb
On Error Resume Next
For Each td In db.TableDefs
If InStr(td.Name, "~") = 0 Then
If InStr(td.Connect, ";DATABASE") <> 0 Then
Set rs = db.OpenRecordset(td.Name)
Exit For
End If
End If
Next
Set rs = Nothing
Set td = Nothing
Set db = Nothing
If Err.Number <> 0 Then
Call Relink
End If
End Sub


Public Sub Relink()
On Error GoTo MyError

Dim db As DAO.Database
Dim strPath As String
Dim td As DAO.TableDef

strPath = DirPicker()
If strPath <> "" Then
Set db = CurrentDb()

For Each td In db.TableDefs
If InStr(td.Connect, ";DATABASE") <> 0 Then
td.Connect = ";DATABASE=" & strPath & "\" & Mid(td.Connect, InStrRev(td.Connect, "\") + 1)
End If
Next

MyExit:
Set td = Nothing
Set db = Nothing
Exit Sub

MyError:
MsgBox "Error during linking. ", 16, ""
Resume MyExit
End If
End Sub