Hi Stephen,
We usually test the link at start up when Splash Screen start up by trying to open one table as shown below.
Private Sub Form_Open(Cancel As Integer)
On Error GoTo Err_Form_Open
Dim dbs As DAO.Database
Dim rst As DAO.Recordset
Dim intRecords As Integer
Dim strIconLocation As Variant
Dim prp As Property
Dim strQuote As String
Const conPropNotFoundError = 3270
intTries = 0
CheckBackEndLinks:
Set dbs = CurrentDb ' Create database reference.
Set rst = dbs.OpenRecordset("tblClusters")
rst.Close
Set rst = Nothing
strIconLocation = CurrentDBDir & "acir.ico"
dbs.Properties("AppIcon") = strIconLocation
Application.RefreshTitleBar
dbs.Close
Set dbs = Nothing
'CheckIfUsingLatestVersion
Call PerformVersionControl
Exit_Form_Open:
Set rst = Nothing
Set dbs = Nothing
DoCmd.SetWarnings True
Exit Sub
Err_Form_Open:
If Err = conBackEndMissing Or Err = conFileMissing Then
strQuote = Chr(34)
'Alert user
strMsg = "MsgBox ('Back-end not found." _
& "@The application will not be able to continue without the back-end database. " _
& "@Please select the data file to use with ACIR Database when the next screen opens for you. " _
& "The default back-end database is usually stored in " & strQuote & "\\fileshare\hnephgeneral\immunisation\acir\acir\ directory" _
& strQuote & " under " & strQuote & "Acir_be.accdb" & strQuote & " name but " _
& "it could be saved with a different name or moved to another location on the network. " & vbCrLf & vbCrLf _
& "Please contact your database administrator for further instructions if you cannot locate the back-end database." & vbCrLf & vbCrLf _
& "Click OK button to continue....', 0 + 48, 'CONNECTION ERROR: Back-End Not Found!')"
Beep
Call Eval(strMsg)
'Display file open database dialogue box and relink tables
RelinkTables ("")
Resume CheckBackEndLinks
Else
If Err = conPropNotFoundError Then ' Property not found.
Set prp = dbs.CreateProperty("AppIcon", _
dbText, strIconLocation)
dbs.Properties.Append prp
Resume Next
Else
MsgBox Err & ": " & Error$, vbExclamation, "Error Opening Splash Screen!"
Resume Exit_Form_Open
End If
End If
End Sub
And re-link if required
Sub RelinkTables(Optional strNewPathname As String)
On Error GoTo Err_RelinkTables
'Purpose: Re-link linked tables to back-end when moved/renamed
'Author: John Fejsa
'Date Created: 8/11/2001
'Last Modified: 24/8/2009
'Modified by: John Fejsa
'Accepts: n/a
'Returns: n/a
'About If someone moves the back-end database or installs the
'database to non-default location path or renames the
'back-end the application will stop working unless
'tables are re-linked. This procedure is designed to
're-link all linked tables. When the full path and name
'of the back-end database is passed to the procedure,
'eg RelinkTables("c:\windows\test.mdb")the procedure
'will go through all the tables in front-end database
'and link all linked tables to passed location
Dim strDBPath As String
Dim strDBFile As String
Dim strFile As String
Dim dbs As DAO.Database
Dim tdf As DAO.TableDef
Dim tdfs As DAO.TableDefs
Set dbs = CurrentDb
Set tdfs = dbs.TableDefs
Dim strFullName As String
Dim strPathOnly As String
Dim rst As DAO.Recordset
Dim intRecords As Integer
If Len(Nz(strNewPathname, "")) > 0 Then
strFullName = strNewPathname
Else
strDBPath = CurrentDb.Name
strDBFile = Dir(strDBPath)
strPathOnly = Left(strDBPath, Len(strDBPath) - Len(strDBFile))
strFullName = strPathOnly & "Immunisations Data.mdb"
End If
Set rst = dbs.OpenRecordset("tblDefaults")
intRecords = rst.RecordCount
If intRecords > 0 Then
rst.Edit
rst!BackEndData = strFullName
rst.Update
End If
Set rst = Nothing
Set dbs = Nothing
RelinkTables:
'Loop through the tables collection
For Each tdf In tdfs
If tdf.SourceTableName <> "" Then 'If the table source is other than a base table
tdf.Connect = ";DATABASE=" & strFullName 'Set the new source
tdf.RefreshLink 'Refresh the link
End If
Next 'Goto next table
Exit_RelinkTables:
Exit Sub
Err_RelinkTables:
Select Case Err
Case conBackEndMissing, conFileMissing 'Display File Picker dialog box to select file
strFullName = libGetOpenFile(strPathOnly, "Select data file to link to...")
Resume RelinkTables
Case conInvalidDatabaseName 'Allow 3 tries, then exit
intTries = intTries + 1
If intTries > 2 Then
strMsg = "Can not continue without back-end database. " _
& "Please contact database administrator for further instructions." & vbCrLf & vbCrLf _
& "Database will close now, please click OK button to exit."
Beep
MsgBox strMsg, vbCritical, "DATA ERROR - Required Linked Database Not Found!"
DoCmd.Quit
End If
Case Else
MsgBox Err & ": " & Error$, vbExclamation, "Error Re-Linking Data Tables!"
Resume Exit_RelinkTables
End Select
End Sub
Hope you can modify supplied code for your own use.
JFejsa
---In MS_Access_Professionals@yahoogroups.com, <zctek@...> wrote:
Hi Steven,
The answer is that you can't..
Just move both files then remake the link in the database so that it
points to the new location of the spreadsheet..
Hope that helps.
Regards, Clive(Williams).
---In MS_Access_Professionals@yahoogroups.com, <ms_access_professionals@yahoogroups.com> wrote:
I have an Access accdb file containing macros. It links to an Excel spreadsheet. How do I move both files? When I try, the link doesn't work.
| Reply via web post | Reply to sender | Reply to group | Start a New Topic | Messages in this topic (4) |
Tidak ada komentar:
Posting Komentar