ReLink Access Table Using UserName 1

[Vulton]

I have an Access Front End that links to several other backend databases. Three of the tables linked to are in an access database that is created from a 3rd party software "on the fly". Every user of this 3rd party software has his/her own user directory where this database is created in...

\\ServerName\UserName\Report.mdb

Currently I have to go into each users front end and relink each persons tables individualy thru the Linked Table Manager.

Is there a way I can use %UserName% in the path of the link or change the link as the user logs in somehow?

Thanks in advance!

 

[jrbarnett]

The general technique for relinking tables through code is demonstrated here:

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

With a little modification, it can be set to do what you want.

John

 

[PHV]

Have a look at the Environ function.

Hope This Helps, PH.
Want to get great answers to your Tek-Tips questions? Have a look at FAQ219-2884 or FAQ181-2886

 

[Vulton]

Thanks again for the help here is what I ended up with...

Function fRefreshLinks(UserName As String) As String
Dim strMsg As String, collTbls As Collection
Dim i As Integer, strDBPath As String, strTbl(2) As String
Dim dbCurr As Database, dbLink As Database
Dim tdfLocal As TableDef

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

On Local Error GoTo fRefreshLinks_Err

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

'now link all of them
Set dbCurr = CurrentDb

strDBPath = "\\Server\Path\Users\" & UserName & "\Report.mdb"
Set dbLink = DBEngine(0).OpenDatabase(strDBPath)

strTbl(0) = "Cabinets"
strTbl(1) = "Job Info"
strTbl(2) = "Rooms"

For i = 0 To 2

If fIsRemoteTable(dbLink, strTbl(i)) Then
'everything's ok, reconnect
Set tdfLocal = dbCurr.TableDefs(strTbl(i))
With tdfLocal
.Connect = ";Database=" & strDBPath
.RefreshLink
collTbls.Remove (.Name)
End With
Else
Err.Raise cERR_NOREMOTETABLE
End If

Next i


fRefreshLinks = UserName & " Linked!"

fRefreshLinks_End:
Set collTbls = Nothing
Set tdfLocal = Nothing
Set dbLink = Nothing
Set dbCurr = Nothing
Exit Function

fRefreshLinks_Err:
fRefreshLinks = "Error Linking - " & UserName
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(i) & "' 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 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