I have made a few recent modifications to this (hence the "2" in
"fRelinkMultipleBackends2") and have not finished "cleaning up" the code.
Hopefully you won't find it TOO confusing.
The intended purpose of this app is to switch between about 10
identically-structured "back-ends" (one for each customer's parts inventory
control) as it was getting very difficult to maintain form and report
updates for each customer.
When you click on the "cmdRefreshLinks" button on the switchboard, a
BrowseFile dialog box pops up and allows you to choose a file for use as the
"back-end". Once the file is selected, the code continues and re-attaches
about 13 (linked) tables from the customer's specific file. I also had one
"pricing" file that never changes ... so I excluded it from having to be
refreshed for no reason. The code now runs continuously until completion ...
which takes about 10 seconds. :)
'--------------------------------------------------------------------
Function LinkOneTable(tdf As TableDef, MyPath As String) As Boolean
'Debug.Print "Attempting to re-link " & tdf.Name
On Error Resume Next
' If the Connect property is non-empty, the table is linked
If Len(tdf.Connect) 0 Then
tdf.Connect = ";DATABASE=" & MyPath
Err.Clear
tdf.RefreshLink ' Re-link the table.
If Err Then
LinkOneTable = False ' This attempt to re-link has failed.
Exit Function
End If
End If
Set tdf = Nothing
LinkOneTable = True ' This link has been succesfully refreshed.
End Function
Public Function fRelinkMultipleBackends2()
'--------------------------------------------------------------------
'Name: fRelinkMultipleBackends (Function)
'Purpose: Re-links attached tables on a
' one-by-one basis, deals with locating
' 'lost' MDB file links.
'Author: Don Leverton
'Date: July 31, 2004, 09:46:28 PM
'Called by: cmdRefreshLinks_Click() on Switchboard form
'Calls: LinkOneTable function
'Inputs: None
'Output: Message that confirms / informs
'Requires: Dev's fGetMDBName() function and GetOpenFileName API from:
'
http://www.mvps.org/access/tables/tbl0009.htm
'Thanks to: Tom van Stiphout, Douglas J. Steele and Dev Ashish
'-------------------------------------------------
Dim MyDB As DAO.Database
Set MyDB = CurrentDb
Dim tdf As DAO.TableDef
Dim intLinkedCount As Integer
Dim intSuccessCount As Integer
Dim strNewPath As String
Dim strTable As String
Dim Result As Boolean
Dim Msg As String
Dim CR As String
CR = vbCrLf
DoCmd.Hourglass True
On Error Resume Next
' Loop through all tables in database.
For Each tdf In MyDB.TableDefs
If InStr(1, tdf.Name, "tblPricing") 0 Then
'"tblPricing" is from a data path that never changes.
' This code excludes it from being processed.
intSuccessCount = intSuccessCount + 1
intLinkedCount = intLinkedCount + 1
GoTo GetNext
End If
If Len(tdf.Connect) 0 Then ' If the Connect property is non-empty,
the Table Is linked
intLinkedCount = intLinkedCount + 1 'Get a count of linked tables
strTable = tdf.Name 'Get the linked table name
' On Error Resume Next
' tdf.RefreshLink 'Attempt to relink table using existing .Connect
property
' If Err.Number <0 Then 'If RefreshLink fails...
If Len(strNewPath) 0 Then
'Try to re-use the existing string if it has already
been Found
Result = LinkOneTable(MyDB.TableDefs(strTable),
strNewPath)
If Result = True Then 'The re-linking of the table was
successful
intSuccessCount = intSuccessCount + 1
GoTo GetNext
Else
GoTo GetPath
End If '(for Result = True)
End If '(for Len(strNewPath) 0)
GetPath:
Msg = ""
Msg = Chr(39) & strTable & Chr(39)
Msg = Msg & " needs to re-linked " & CR
Msg = Msg & "to it's 'back-end' MDB file" & CR & CR
Msg = Msg & "Please select it's location " & CR
Msg = Msg & "from the next dialog box."
MsgBox (Msg)
strNewPath = fGetMDBName("Please select a new datasource
for: " & strTable)
Result = LinkOneTable(MyDB.TableDefs(strTable), strNewPath)
' Else
intSuccessCount = intSuccessCount + 1 'RefreshLink was
successful
' End If '(for Err <>0)
End If '(for Len tdf)
GetNext:
Next tdf
MyDB.TableDefs.Refresh
Msg = ""
Msg = Msg & intSuccessCount & " of "
Msg = Msg & intLinkedCount & CR
Msg = Msg & "linked tables have been " & CR
Msg = Msg & "successfully re-linked."
MsgBox (Msg)
Set tdf = Nothing
Set MyDB = Nothing
DoCmd.Hourglass False
End Function
=================
HTH,
Don
=================
"bubbles" <bu*********@hotmail.comwrote in message
news:11*********************@q75g2000hsh.googlegro ups.com...
Using Access 2003 front-end, with SQL Server 2005 backend.
I need to make the front-end application automatically refresh the
linked
SQL Server tables.
New tables will be added dynamically in the future, so the front-end
application
must have a way to keep up with this (instead of manually linking
them).
Anyone knows of a way to refresh the links programmatically via VBA?
Thanks,
Bubbles
