Deploying Access and linked tables 3

[Kukulkania]

I am trying to deploy an Access database without having the end-users manually run Tools -> Database Utilities -> Linked Table Manager -> etc... Is there any manner by which I can achieve an installation and automatic linked table update (including the possibility of using InstallShield, Install Maker Pro, or another tool)?

Thanks, Matt

 

[wemeier]

You could write a function that walks through the TableDefs and, for each linked table, replaces the Connection property with the path to the back-end database.

I need a few questions answered to help you more:

Will the back-end database be installed in the sale folder as the front-end database?

Does the back-end database remain constant with every deploy (i.e. if deploying internally, every user has access to the back-end database which remains static on a company file server)?

Can you ask the user to select the back-end database using a Windows dialog box?

Depending on the answers, you can approach this in several ways.

 

[Kukulkania]

1. Although some may elect to keep the back-end and front-end in the same folder, most will not.
2. The back-end location (and potentially back-end database type) will vary from installation to installation.
3. We most certainly can open a dialog box to ask the user questions.

Specifically, my wife has written many Access databases, and one customer is intending on selling the product. They are going to a show in Texas in a couple of months, and want to 'streamline' the installation of a trial product. Being more of a network / development person, I am helping in getting the installation process as simple as is possible, and may overlook solutions that are obvious to the Access officianado (hence my original question). UNIX and BSD-ish questions I can answer[g].

I appreciate your input and assistance.

 

[JimInKS]

Here is what I have done for our internal use. This works well with DAO.

In my FE I have a table I call CONFIG and a corresponding form that allows setting global info about the application. This includes the pathname to the BE folder (I usually use UNC notation for these, but it is not required), a pathname to a local folder (Some of my apps create temporary tables).

The Config form has several buttons for tasks related to setup of the database.

TABLE LIST
Opens a table that I use to specify the names of tables to be linked. It consists of 4 fields:
LinkTblName: The name of the linked table in the FE.
SrcTblName: The name of the table in the BE.
DBname: The BE filename.
LocalPathFlag: Indicates if the db file is located on the local system or server.

LINK TABLES
Runs the following code which walks thru TABLE LIST and recreates all links.

Here are the pertenant routines:

Function LinkDBTables()
' Code Header inserted by VBA Code Commenter and Error Handler Add-In
'=============================================================
' LinkTables.LinkDBTables
'-------------------------------------------------------------
' Purpose: Link all backend tables specified in table 'TblsToLink'
' Author : Jim Seley, Wednesday, March 05, 2003
' Notes :
'-------------------------------------------------------------
' Parameters
'-----------
'
'-------------------------------------------------------------
' Returns: 0=Success, Access Error Number on Fail
'-------------------------------------------------------------
' Revision History
'-------------------------------------------------------------
' Wednesday, March 05, 2003 jcs:
'=============================================================
' End Code Header block

Dim db As Database
Dim tdf As TableDef
Dim rs As Recordset
Dim DBPathD As String, DBPathT As String
Dim ans As Integer

If Not Debug_mode Then On Error GoTo HandleErr
LinkDBTables = -1

' Get Pathname info from 'Config' table
Set db = CurrentDb()
Set rs = db.OpenRecordset("SELECT * FROM config WHERE activeflag=TRUE;&quot
DBPathD = rs!DataDbPath ' Set Test Data path
DBPathT = rs!LocalDBPath ' Set TEMP path
rs.Close

' Check pathnames are valid
If Dir$(DBPathD, vbDirectory) = "" Then
ans = MsgBox("Data db path " & DBPathD & " not found.", vbexclamation)
Exit Function
End If
If Dir$(DBPathT, vbDirectory) = "" Then
ans = MsgBox("Local db path " & DBPathT & " not found.", vbexclamation)
Exit Function
End If

' Link the specified local/network tables
Set rs = db.OpenRecordset("TblsToLink&quot
Do While Not rs.EOF
If rs!LocalPathFlag Then
ans = LinkAccessTable(rs!LinkTblName, rs!SrcTblName, DBPathT & "\" & rs!DbName)
Else
ans = LinkAccessTable(rs!LinkTblName, rs!SrcTblName, DBPathD & "\" & rs!DbName)
End If
rs.MoveNext
Loop
rs.Close

MsgBox ("Finished Linking Tables&quot
LinkDBTables = 0

ExitHere:
Exit Function

' Error handling block added by VBA Code Commenter and Error Handler Add-In. DO NOT EDIT this block of code.
HandleErr:
LinkDBTables = Err
Select Case Err.Number
Case Else
ErrorMsg
End Select
' End Error handling block.
End Function

Function LinkAccessTable(LinkTblName As String, SrcTblName As String, DBPath As String)
' Code Header inserted by VBA Code Commenter and Error Handler Add-In
'=============================================================
' LinkTables.LinkAccessTable
'-------------------------------------------------------------
' Purpose: Link / Re-Link a specified backend table
' Author : Jim Seley, Wednesday, March 05, 2003
' Notes :
'-------------------------------------------------------------
' Parameters
'-----------
' LinkTblName (String): Name of the Linked table in curret db
' SrcTblName (String) : Name of the table in the backend db
' DBPath (String) : Pathname of backend db
'-------------------------------------------------------------
' Returns: 0=Success, -1=Error
'-------------------------------------------------------------
' Revision History
'-------------------------------------------------------------
' Wednesday, March 05, 2003 jcs:
'=============================================================
' End Code Header block
Dim db As Database
Dim tdf As TableDef

On Error GoTo HandleErr

LinkAccessTable = -1

Set db = CurrentDb()
Set tdf = db.CreateTableDef(LinkTblName)
tdf.Connect = ";DATABASE=" & DBPath
tdf.SourceTableName = SrcTblName
db.TableDefs.Delete LinkTblName ' Remove any existing link
db.TableDefs.Append tdf
db.TableDefs.Refresh
LinkAccessTable = 0

ExitHere:
Exit Function

' Error handling block added by VBA Code Commenter and Error Handler Add-In. DO NOT EDIT this block of code.
HandleErr:
Select Case Err.Number
Case 3265 ' Table does not currently exist
Resume Next
Case Else
ErrorMsg
End Select
' End Error handling block.
End Function

 

[wemeier]

Kukulkania,

I do something a little different than JimInKS. I have a routine that first checks for the BE table in the current directory. If it doesn't find it there, it checks it in its original location (the current Connect property). If it doesn't find a good link there, it prompts the user for the location of the BE database using a Windows open dialog box. I run this code every time the FE database is opened (in case the links get broken or the BE database is moved).

 

[Millardy]

wemeier,

I've been searching this forum and this is the answer I have been looking for. My situation is about the same as Kukulkania - Being fairly new to access and databases, plus my first time using Office XP Developer to deploy my Access 2002 Fe and Be. Could you expand some on your response:
"I have a routine that first checks for the BE table in the current directory. If it doesn't find it there, it checks it in its original location (the current Connect property). If it doesn't find a good link there, it prompts the user for the location of the BE database using a Windows open dialog box. I run this code every time the FE database is opened (in case the links get broken or the BE database is moved)."

Thanks for your help,
EMillard

 

[wemeier]

I have a subroutine called CheckTableLinks that walks all tabledefs in the Tables collection and interrogates the Connect property. If the Connect property is not empty, it's a linked table. I then try to find the table name in the folder that the application resides in (I do this for testing -- I copy the FE and BE databases into a non-production folder. If it's found, I go on to the next table. Otherwise, I check to see if the table name still resides in the database listed in the Connect property. If I find the table, fine. Otherwise, I send a standard Windows open dialog box to the user and ask him to select the database that holds the table.

I continue the process until I've examined every tabledef in the Tables collection. If you want, I can post the code here.

Cruising the Information Superhighway
_{(your mileage may vary)}

 

[eti3nne]

I've been investigating what I should do re splitting a database and the next step is thinking about distributing the split database and updating it. Can I take you up on your offer to post your CheckTableLinks code?

Cheers.

 

[Millardy]

Thanks for the offer - I would definitely appreciate you posting your code. Thanks!

 

[brightstar]

me too!

http://www.agonyonline.co.uk

free, anonymous advice provided by the whole world

 

[brightstar]

or what if i wanted it to be a lot simpler.
like if i had one config table with the table name, the table name in the source, the source database path and i wanted to loop through them setting up the links.

and that was all.
thats all i need and the rest of this code is hurting my head.

http://www.agonyonline.co.uk

free, anonymous advice provided by the whole world

 

[wemeier]

I haven't forgotten about you guys. My laptop crashed and I have to rebuild it to get my databases back. I'll post in a day or so.

Cruising the Information Superhighway
_{(your mileage may vary)}

 

[risicare]

Try this. I can't for the life of me remember where I got this little lot from, could possibly have been Getz & Litwin.

Put this code with your start-up form. This code contains some other stuff 'cos it's from one of my projects.

Private Sub cmdbtn_yes_Click()

' Tests a linked table for valid back-end

On Error GoTo Err_Form_Open
Dim strTest As String, db As Database
Dim td As TableDef
Set db = CurrentDb
For Each td In db.TableDefs
If Len(td.Connect) > 0 Then ' Is a linked table
On Error Resume Next ' Turn off error trap
strTest = Dir(Mid(td.Connect, 11)) ' Check file name
On Error GoTo Err_Form_Open ' Turn on error trap
If Len(strTest) = 0 Then ' No matching file.
If MsgBox("Couldn't find the back-end file " & _
Mid(td.Connect, 11) & ". Please choose new data file.", _
vbExclamation + vbOKCancel + vbDefaultButton1, _
"Can't find backend data file.") = vbOK Then
DoCmd.OpenForm "frm_newdatafile" ' Open prompt form.
Exit Sub ' To refresh links
Else
MsgBox "The linked tables can't find their source. " & _
"Please log onto network and restart application."
Application.Quit acQuitSaveNone
End If
End If
End If
Next ' Loop to next tabledef.

'reset the timer auto time-out function
If Forms![frm_startup].TimerInterval <> 0 Then
Forms![frm_startup].TimerInterval = 0
End If

DisableBypassKey
DoCmd.OpenForm "frm_switchboard_main"
DoCmd.Close acForm, "frm_startup"

Exit_Form_Open:
Exit Sub
Err_Form_Open:
MsgBox "Message " & Error.Description
Resume Exit_Form_Open

End Sub

Make a dialog form incorporating the xDialog ActiveX control. Have a 'browse' command button that calls the Browse function and a 'relink' command button that calls the Process Tables function from the following code that should be in a module (call it Relink or something):

Option Compare Database
Option Explicit

Dim UnProcessed As New Collection


Public Function Browse()
' Prompts user for back-end database file name.
On Error GoTo Err_Browse
Dim strFileName As String
Dim oDialog As Object
Set oDialog = [Forms]![frm_newdatafile]!xDialog.object
With oDialog ' Ask for new file location
.DialogTitle = "Please Select New Data File"
.Filter = "Access Database (*.mdb;*.mda;*.mde;*.mdw)|" & _
"*.mdb; *.mda; *.mde; *.mdw|All(*.*)|*.*"
.FilterIndex = 1
.ShowOpen
' If user repsonded, put selection into text box on form.
If Len(.FileName) > 0 Then _
[Forms]![frm_newdatafile]![txtFileName] = .FileName
End With

Exit_Browse:
Exit Function
Err_Browse:

MsgBox Err.Description
Resume Exit_Browse

End Function

Public Sub AppendTables()
Dim db As Database, X As Variant
' Add all linked table names into the unprocessed collection.
Set db = CurrentDb
ClearAll
For Each X In db.TableDefs
If Len(X.Connect) > 1 Then
UnProcessed.Add Item:=X.Name, Key:=X.Name
End If
Next

End Sub

Public Function ProcessTables()
Dim vTest As Variant
On Error GoTo Err_BeginLink

' Call procedure to add all linked tables into a collection.

AppendTables

' Test for existence of file name \ directory selected in
' Common Dialog control.

vTest = [Forms]![frm_newdatafile]![txtFileName]

On Error GoTo Err_BeginLink
If IsNull(vTest) Then ' File Not Found
MsgBox "File not found. Please try again.", vbExclamation, _
"Link to new data file"
Exit Function
End If


vTest = Dir([Forms]![frm_newdatafile]![txtFileName])
On Error GoTo Err_BeginLink
If Len(vTest) = 0 Then ' File Not Found
MsgBox "File not found. Please try again.", vbExclamation, _
"Link to new data file"
Exit Function
End If

' Begin relinking tables.

Relinktables (vTest)

' Check to see if all tables have been relinked.

CheckifComplete

DoCmd.Echo True, "Done"

If UnProcessed.Count < 1 Then
MsgBox "Linking to new back-end data file was successful."
Else
MsgBox "Not all back-end tables were successfully relinked."
End If

DoCmd.Close acForm, [Forms]![frm_newdatafile].Name

Exit_BeginLink:
DoCmd.Echo True
Exit Function

Err_BeginLink:
If Err.Number = 457 Then
ClearAll
Resume Next
End If
MsgBox Err.Number & ": " & Err.Description
Resume Exit_BeginLink

End Function


Public Sub ClearAll()
Dim X
' Clear and and all names from the Unprocessed Collection.
For Each X In UnProcessed
UnProcessed.Remove (X)
Next

End Sub

Public Function Relinktables(strFileName As String)

Dim dbbackend As Database, dblocal As Database, ws As Workspace, _
X, Y
Dim tdlocal As TableDef

On Error GoTo Err_Relink

Set dbbackend = DBEngine(0).OpenDatabase(strFileName)
Set dblocal = CurrentDb

' If the local linked table name is found in the back-end database we'e
' looking at, recreate and refresh its connect string, and then remove
' its name from the Unprocessed collection.

For Each X In UnProcessed
If Len(dblocal.TableDefs(X).Connect) > 0 Then
For Each Y In dbbackend.TableDefs
If Y.Name = X Then
Set tdlocal = dblocal.TableDefs(X)
tdlocal.Connect = ";DATABASE=" & _
Trim([Forms]![frm_newdatafile]![txtFileName])
tdlocal.RefreshLink
UnProcessed.Remove (X)
End If
Next
End If
Next

Exit_Relink:
Exit Function
Err_Relink:
MsgBox Err.Description
Resume Exit_Relink

End Function

Public Sub CheckifComplete()

Dim vTest As Variant, Y As String, notfound As String, X

' If there are any names left in the unprocessed collection, then continue.

If UnProcessed.Count > 0 Then
For Each X In UnProcessed
notfound = notfound & X & Chr(13)
Next
' List the tables that have not yet been relinked.
Y = MsgBox("The following tables were not found in " & _
Chr(13) & Chr(13) & [Forms]![frm_newdatafile]!txtFileName _
& ":" & Chr(13) & Chr(13) & notfound & Chr(13) & _
"Select another database that contains the additional tables?", _
vbQuestion + vbYesNo, "Tables not found")
If Y = vbNo Then
Exit Sub
End If

' Bring the Common Dialog control back up.
Browse
vTest = Dir([Forms]![frm_newdatafile]![txtFileName])
If Len(vTest) = 0 Then ' File not found
MsgBox "File not found. Please try again.", vbExclamation, _
"Link to new data file"
Exit Sub
End If
'Debug.Print "Break"
Relinktables (vTest)
Else
Exit Sub
End If

CheckifComplete

Exit_BeginLink:
DoCmd.Echo True ' Just in case of error jump.
DoCmd.Hourglass False
Exit Sub

Err_BeginLink:
Debug.Print Err.Number
If Err.Number = 457 Then
ClearAll
Resume Next
End If
MsgBox Err.Number & ": " & Err.Description
Resume Exit_BeginLink

End Sub

I hope this helps. I've never had a problem with relinking the tables with this routine with any of the systems this db has been installed on.
J.

 

[wemeier]

Here's the code that I use. It's very similar to risicare's:
[bold][blue]
Public Function CheckTableLinks(Optional CheckLocalFirst As Boolean = False, Optional IgnoreTempTables As Boolean = False) As Boolean
' Check all tables in the current application to ensure that
' all linked tables are pointing to a good database. If a link
' fails, check to see if the database name is in the same directory
' as the application database and, if so, try to relink the table
' to that database.
Dim db As Database
Dim tdf As TableDef
Dim fAllLinksGood As Boolean
Dim fFirstTime As Boolean
Dim intNumTables As Integer
Dim intResp As Integer
Dim intTable As Integer
Dim strOldConnect As String
Dim strConnect As String
Dim strDBName As String
Dim strDBDir As String
Dim varReturn As Variant
Dim intRelinkedTables As Integer
Dim intBadLinks As Integer

On Error GoTo CheckTableLinks_Err

' Get the name of the current database directory
strDBDir = GetDBDir()

fAllLinksGood = True
' Find the number of tables to check and start the progress meter
Set db = CurrentDb()
intNumTables = db.TableDefs.Count
varReturn = SysCmd(acSysCmdInitMeter, "Checking table links", _
intNumTables)

' Loop through all tables.
' Re-attach those with nonzero-length Connect strings.
intRelinkedTables = 0
intBadLinks = 0
intTable = 0
For Each tdf In db.TableDefs
intTable = intTable + 1
' If connect is blank, its not an Linked table
If Len(tdf.Connect) > 0 And left(tdf.Connect, 5) <> "ODBC;" Then
' check the current table to see if it can find the
' first field name in the table; if it can't, the
' link is bad
If left(tdf.Name, 3) = "tmp" And IgnoreTempTables Then
ElseIf (CheckLocalFirst Or CheckLink(tdf.Name) = False) Then
strDBName = GetDBFilename(tdf.Connect)
strOldConnect = tdf.Connect
tdf.Connect = ";DATABASE=" & strDBDir & strDBName
' The RefreshLink might fail if the new path
' isn't OK. So trap errors inline.
On Error Resume Next
tdf.RefreshLink
' If link bad and checking local first, try the original link
If Err <> 0 And CheckLocalFirst Then
tdf.Connect = strOldConnect
On Error Resume Next
tdf.RefreshLink
End If
' If link still bad (or not checking local first) ask for location of table
If Err <> 0 Then ' if the link is no good...
Do ' prompt the user for the correct database
If fFirstTime Then ' if first time in, start user in current database's folder
strConnect = OfficeOpenFileName("Database Files (*.mdb)|All Files (*.*)", 0, strDBDir, strDBName, "Select new location of " & tdf.Name, "Link")
fFirstTime = False
Else ' otherwise, start use in last folder user selected
strConnect = OfficeOpenFileName("Database Files (*.mdb)|All Files (*.*)", 0, , strDBName, "Select new location of " & tdf.Name, "Link")
End If
If strConnect <> "" Then ' if a database name was supplied, try to connect to it
tdf.Connect = ";DATABASE=" & strConnect
On Error Resume Next
tdf.RefreshLink
End If
Loop Until Err = 0 Or strConnect = "" ' until he either correctly connects it or cancels.
If strConnect = "" Then ' if the user cancelled trying to link the table...
fAllLinksGood = False ' ... count it as an unresolved link
intBadLinks = intBadLinks + 1
End If
Else
intRelinkedTables = intRelinkedTables + 1
End If
End If
End If
varReturn = SysCmd(acSysCmdUpdateMeter, intTable + 1)
Next tdf

' Reset the progress meter
On Error Resume Next
varReturn = SysCmd(acSysCmdRemoveMeter)

' If any tables were successfully re-linked, display a message with that fact
If intRelinkedTables > 0 Then
MsgBox intRelinkedTables & " tables were relinked to databases in the current directory.", , "Check Table Links"
End If

' If any table links were unsuccessful, send the user to the Linked Table Manager
If Not fAllLinksGood Then
MsgBox intBadLinks & " tables were not relinked successfully!@Some databases could not be relinked!@Select Tools * Add-ins * Linked-table Manager to resolve missing links.", vbCritical
End If

CheckTableLinks_Exit:
CheckTableLinks = fAllLinksGood
On Error GoTo 0
Exit Function

CheckTableLinks_Err:
Select Case Err
Case Else
MsgBox "Error#" & Err.Number & ": " & Err.Description, _
vbOKOnly + vbCritical, "CheckTableLinks"
Resume CheckTableLinks_Exit
End Select

End Function

Private Function CheckLink(strTable As String) As Boolean

' Purpose:
' Checks the Link for the named table.
' Based on code from Ken Getz.
'
' From Access 97 Developer's Handbook
' by Litwin, Getz and Gilbert. (Sybex)
' Copyright 1997. All Rights Reserved.
'
' In:
' strTable - table to check
' Out:
' Return Value - True if successful; False otherwise
' History:
' Created 09/13/94 pel; Last Modified 07/10/96 pel

Dim varRet As Variant

On Error Resume Next

' Check for failure. If can't determine the name of
' the first field in the table, the link must be bad.
varRet = CurrentDb.TableDefs(strTable).Fields(0).Name
If Err <> 0 Then
CheckLink = False
Else
CheckLink = True
End If

End Function

Private Function GetDBDir() As String
' Purpose:
' Returns the directory of the currently open database.
'
' In:
' None
' Out:
' Return Value - The name of the directory as a string (including the ending slash)

GetDBDir = left$(CurrentDb.Name, Len(CurrentDb.Name) - Len(Dir(CurrentDb.Name)))

End Function

Private Function GetDBFilename(strDBName As String) As String

' Purpose:
' Extracts the filename from a Window file name
' in the format drive:\path(s)\filename.
' Based on code originally from Mike Gunderloy.
'
' In:
' None
' Out:
' Return Value - The name of the file as a string
' History:
' Created 02/10/99 wem; Last Modified 02/11/99 wem

On Error GoTo GetDBFilenameErr

Dim strProcName As String
Dim strFileName As String

strProcName = "GetDBFilename"

Do While Right$(strDBName, 1) <> "\" And Len(strDBName) > 0
strFileName = Right$(strDBName, 1) & strFileName
strDBName = left$(strDBName, Len(strDBName) - 1)
Loop

GetDBFilename = strFileName

GetDBFilenameDone:
On Error GoTo 0
Exit Function

GetDBFilenameErr:
Select Case Err
Case Else
MsgBox "Error#" & Err.Number & ": " & Err.Description, _
vbOKOnly + vbCritical, strProcName
Resume GetDBFilenameDone
End Select

End Function
[/bold][/blue]

Cruising the Information Superhighway
_{(your mileage may vary)}

 

[e006823]

Wemeier,

When I try your code I get an error message "Sub or Function not defined" for the lines with "OfficeOpenFileName" in them. Is there a reference I'm missing?

Thanks,
e006823

 

[wemeier]

e006832, sorry about that. There's another set of functions that I left out. The function is basically to open a Windows "File | Open" dialog box to get the name of the database to link to. It's coding that I got from "Access Developer's Handbook", so I can't post it here.

However, you can:

1. Substitute your own function that does the same thing (if you have it),

2. Display an input box to get the full path and name of the databsae, or

3. Search for coding on the Internet that does the same thing.

Sorry I can't help you out more.

Cruising the Information Superhighway
_{(your mileage may vary)}