Oops I posted as you were posting Gazza...
Thanks for the example - I used a similar one and adapted it to this...
Maybe I should just post my adapted code to make things easier for you and RG...(NOTE: the start form doesn't display if an error is generated)
Also I've made comments where I'm struggling....(amongst the normal comments)
----------------------------------------------------------------
Private Sub Form_Error(DataErr As Integer, Response As Integer)
'varMDBPath and varMDBPathNew are procedure level variables to be used in
' the Form Load and Form Error events
Dim tbldef As DAO.TableDef
Dim vItem As Variant, vMDBFind As String
On Error GoTo Err_fix
Response = acDataErrContinue
'See if office backend exists or can be referenced from Users PC
With Application.FileSearch
.FileName = "AMTBack.mdb"
.LookIn = "\\Louise-pc\p5\AMT\AMTBackend (DONT TOUCH)"
.SearchSubFolders = True
.Execute
For Each vItem In .FoundFiles
vMDBFind = vItem
Next vItem
End With
'line below is the full path to office backend
varMDBPath = "\\Louise-pc\p5\AMT\AMTBackend (DONT TOUCH)\AMTBack.mdb"
'See what the current backend is
varMDBPathNew = Mid([CurrentDb].[TableDefs]("CompanyInformation").[Connect], 11)
If Len(vMDBFind) > 0 Then 'If length is greater than 0 then office backend can be referenced...
If varMDBPath = vMDBFind Then 'If the found office backend matches what it should be...
For Each tbldef In CurrentDb.TableDefs 'Relink to office backend
If Len(tbldef.Connect) > 0 Then
tbldef.Connect = ";DATABASE=" & varMDBPath
tbldef.RefreshLink
End If
Next tbldef
MsgBox "CHANGED LINK: AMT knows you are back in the office and has now been re-connected " & _
"to the office back end..." & Chr(10) & Chr(10) & "Because the original link was " & _
"lost, AMT will now quit but will " & Chr(10) & _
"open normally using the OFFICE backend next time you " & _
"open it...", vbOKOnly + vbExclamation, "Link status...WELCOME BACK TO THE OFFICE!!"
End If
Else
'If the office backend doesn't exist - go hunt another one
MsgBox "CHANGED LINK: You have changed location or AMT has been moved or deleted..." & Chr(10) & Chr(10) & _
"Click OK for AMT to find another back end on your computer...(C:\ drive search ONLY)" & _
Chr(10) & Chr(10) & "Warning: This may take some time...", vbOKOnly + vbCritical, "Link status..."
DoCmd.Hourglass True
varMDBPath = GetFullPath("AMTBack.mdb", "C:") 'This function searches for a back-end on C Drive
For Each tbldef In CurrentDb.TableDefs 'When found re-link to temp backend
If Len(tbldef.Connect) > 0 Then
tbldef.Connect = ";DATABASE=" & varMDBPath
tbldef.RefreshLink
End If
Next tbldef
DoCmd.Hourglass False
MsgBox "AMT was linked to another back end on your computer (OUT OF OFFICE)..." & Chr(10) & Chr(10) & _
"Backend path = " & varMDBPath & Chr(10) & Chr(10) & _
"Because the original link was lost, AMT will now quit but will " & Chr(10) & _
"open normally using the TEMPORARY backend next time you open it...", vbOKOnly + vbExclamation, "Link status...TEMP back end used..."
End If
DoCmd.Quit 'Not the ideal solution - I'd rather just re-display the form without quitting
'DoCmd.Close 'Using 'IsLoaded' shows the form as loaded so close it - can't find a way to display it
'DoCmd.OpenForm "Start" - Re-opening the form crashes Access
Exit_fix:
Exit Sub
Err_fix:
MsgBox "There was an error re-linking to the backend or no backend was found...", vbOKOnly + vbExclamation, "Link status..."
Resume Exit_fix
End Sub
---------------------------------------------------------------
Private Sub Form_Load()
On Error GoTo Err_fix
Dim db As DAO.Database
Dim snp As DAO.Recordset
Dim msg As String
Dim tbldef As DAO.TableDef
Dim vItem As Variant, vMDBFind As String
'If no error is generated because a backend is already linked - test to see if there is an office
'backend available - we don't want users to keep using a temp backend in the office
With Application.FileSearch
.FileName = "AMTBack.mdb"
.LookIn = "\\Louise-pc\p5\AMT\AMTBackend (DONT TOUCH)"
.SearchSubFolders = False
.Execute
For Each vItem In .FoundFiles
vMDBFind = vItem
Next vItem
End With
'line below is the office backend
varMDBPath = "\\Louise-pc\p5\AMT\AMTBackend (DONT TOUCH)\AMTBack.mdb"
'read the current backend used
varMDBPathNew = Mid([CurrentDb].[TableDefs]("CompanyInformation").[Connect], 11)
'If office backend is found - re-link to it and ditch the temp one...
If Len(vMDBFind) > 0 Then
If varMDBPath = varMDBPathNew Then 'If a perfect match then User is using office backend already
'MsgBox "You are already connected to the office backend...", vbOKOnly + vbInformation, "Link status..."
Else
'If not a perfect match then re-link to office backend anyways to prevent users from using the wrong backend
For Each tbldef In CurrentDb.TableDefs
If Len(tbldef.Connect) > 0 Then
tbldef.Connect = ";DATABASE=" & varMDBPath
tbldef.RefreshLink
End If
Next tbldef
MsgBox "AMT knows you are back in the office and has now been re-connected " & _
"to the office backend...", vbOKOnly + vbExclamation, "Link status...WELCOME BACK TO THE OFFICE!!"
End If
'Assign warning font colours so users can easily see if they what backend they are assigned to
Me.txtPathDest = "OFFICE BACKEND"
Me.txtPathDest.ForeColor = 65280
Me.AppPath.ForeColor = 65280
Else
Me.txtPathDest = "TEMPORARY BACKEND"
Me.txtPathDest.ForeColor = 26367
Me.AppPath.ForeColor = 26367
End If
'Boot off code so I can mess with backend
Set db = CurrentDb
Set snp = db.OpenRecordset("Settings", dbOpenSnapshot)
If snp![Logoff] Then
msg = "The system is closed for maintenance..." & vbCrLf & vbCrLf & "Please try later..."
MsgBox msg, vbOKOnly + vbExclamation, "Maintenance status..."
Application.Quit
End If
Dim intX As Integer
Me.AppPath = varMDBPathNew 'Show users backend path on Start form - it's okay they can't get in coz
'it's locked out to them
'Me.AppPath = Application.CurrentProject.Path - ' Front end path
'Set all the icons and give a countdown to opening
Me.txtTime.Visible = False
Me.lblCounting.Visible = False
Me.lblSeconds.Visible = False
Me.chkDesigner = False
Me.chkUser = False
Me.txtTime = 0
Const DB_Text As Long = 10
strSavePath = DLookup("[AppPath]", "CompanyInformation")
intX = AddAppProperty("AppTitle", DB_Text, "AIMS Mini Tools - AMT")
intX = AddAppProperty("AppIcon", DB_Text, strSavePath & "\AIMSIcon.bmp")
CurrentDb.Properties("UseAppIconForFrmRpt") = 1
Application.RefreshTitleBar
Set db = Nothing
Set snp = Nothing
Exit_fix:
Exit Sub
Err_fix:
MsgBox "There was an error re-linking to the backend...", vbOKOnly + vbExclamation, "Relink status..."
Resume Exit_fix
---------------------------
Many thanks in advance to both of you
dazza61