Re-open form after Error Event

dazza61

Registered User.
Local time
Today, 14:19
Joined
Feb 7, 2006
Messages
60
Hi guys,

I'm stumped on this one....here's the code...

Private Sub Form_Error(DataErr As Integer, Response As Integer)
On Error GoTo Err_fix
Response = acDataErrContinue

' \\\ Various code to link to new backend, etc


DoCmd.Close 'On testing - Acccess thinks the form is open so close it

DoCmd.OpenForm "Start" ' Re-opening form causes Access to crash

Exit_fix:
Exit Sub
Err_fix:
MsgBox "There was an error re-linking to the backend...", vbOKOnly + vbExclamation, "Link status..."
Resume Exit_fix
End Sub

Is it possible to re-open a form after the Form Error event is fired?

Many thanks in advance


dazza61
 
I guess my question would have to be: "Why close the form? Just handle the error and leave the form open!"
 
Relink to backend

Hi dazza,

Have a look at this example, I think it is what you are trying to achieve.
If you have any problems or errors let me know because you might have to have certain references switched on for the code to work.

Try it anyway and let me know.

Gazza
 

Attachments

Thanks for the reply RG...

I agree with you - I shouldn't have to close the form, etc...

What happens is, the Load Event triggers an error when it can't find the the office backend. I then put code in the Form Error event to deal with this, assigning a temporary backend (people moving between office and home, etc).
Thing is when an error occurs, the form isn't actually displayed, although if you use an 'IsLoaded' function it shows as being loaded. I thought in my simpleton way, that I could close the form then re-open it - messy but couldn't think of a workaround...closing a form that isn't displayed then crashes the app...

Any ideas?

dazza61
 
You should be handling the error in the Load event where it occurs. Have you tried that?
 
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
 

Users who are viewing this thread

Back
Top Bottom