I've done something SIMILAR.
Background:
=========
I used to have about 8 or 10 "identical" databases that I use to control
parts inventory at several of my customers.
"Identical" is in quotes because they all started out that way <grin...
but I would make an improvement (modification) in one of them, and just
never quite "got around to" modifying the rest of them.
I also fooled around with replication ... and hated it.
I decided that I would make ONE master (front-end) database, and then
re-link to whatever back-end I wanted to use. That way, all of the forms,
reports, etc would only have to be changed ONCE. I also change the TITLE of
my app, using code, so that it displays the company name of the customer
that I am working on. I also use an additional linked table that does NOT
change, so I "mickey-moused" my way around having to re-link that table
every time.
================================
I have a command button on frmSwitchboard called cmdRefreshLinks.
There is also a listbox (lstLinkedTables) that uses an SQL statement to
retreive the table names from the database itself.
SELECT DISTINCTROW MSysObjects.Name, MSysObjects.Database
FROM MSysObjects
WHERE (((MSysObjects.Database) Is Not Null))
ORDER BY MSysObjects.Name;
---------------------------------------------------------
Private Sub cmdRefreshLinks_Click()
fRelinkMultipleBackends2
Me.lstLinkedTables.Requery
Dim intX As Integer
Dim MyAppName As String
MyAppName = DLookup("CompanyName", "tblCompanyInformation")
intX = AddAppProperty("AppTitle", dbText, MyAppName)
'intX = AddAppProperty("AppIcon", dbText, "C:\Windows\Cars.bmp")
RefreshTitleBar
End Sub
---------------------------------------------------------
This function adds the company name to the title bar -- copied/pasted from
Help--
Function AddAppProperty(strName As String, varType As Variant, varValue As
Variant) As Integer
Dim dbs As Database, prp As Property
Const conPropNotFoundError = 3270
Set dbs = CurrentDb
On Error GoTo AddProp_Err
dbs.Properties(strName) = varValue
AddAppProperty = True
AddProp_Bye:
Exit Function
AddProp_Err:
If Err = conPropNotFoundError Then
Set prp = dbs.CreateProperty(strName, varType, varValue)
dbs.Properties.Append prp
Resume
Else
AddAppProperty = False
Resume AddProp_Bye
End If
End Function
---------------------------------------------------------
Here is the function that does the work.... It is kept in the "Modules"
section of the Database window
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
----------------------------------
'--------------------------------------------------------------------
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
===============================================
Long-winded ... but I hope it helps you with your project!
Don
<Ap******@gmail.comwrote in message
news:11**********************@d57g2000hsg.googlegr oups.com...
Hello
I currently Link the FE/BE using the LinkTables Option and the Linked
Table Manager. Any time I need to move the BE to another location, I
have to go through this process over again. I need the flexibility of
being able to move the BE data to wherever I want, without manually
going through this process. I just want to change the Path/Filename
that I keep in a FE Table.
I want to be able to place a Path/Filename in a FE Table that points
to the BE Tables location. I want my code to automatically
connect to the BE Tables by using this Path/Filename as the reference.
How do I approach this? Is there any code available that meets this
criteria?
Thanks
Greg
