K
Kirk P.
I've got this function that monitors the called function for errors. The
called function returns True if successful, and False if there are errors.
If the called functions return False, I want to bail out on this sub. The
problem is, the error message associated with the called function is reported
twice. Other than the same message box appearing twice, everything works as
planned. How do I avoid the duplicate message boxes reporting the same error
(3151)?
Sub BuildTables()
Dim datStart As Date
Dim datEnd As Date
Dim lngLoop As Long
Dim Msg As String
Dim Ans As Integer
DoCmd.SetWarnings (False)
datStart = Now()
Call BuildPACTable
If BuildPACTable = True Then
If DCount("*", "qselUnassignedSiteID") > 0 Then
Forms!frmSwitchboard!cmdNewSite.Enabled = True
End If
Else
Exit Function
End If
datEnd = Now()
'Creates a message box
Msg = "Process completed successfully!"
Msg = Msg & vbNewLine & vbNewLine
Msg = Msg & "Process Time: " & DateDiff("n", [datStart], [datEnd]) & "
minutes"
Ans = MsgBox(Msg, vbInformation, "Refresh Status")
DoCmd.SetWarnings (True)
End Sub
The Called Function is this:
Function BuildPACTable()
On Error GoTo BuildPACTable_Err
DoCmd.SetWarnings (False)
DoCmd.OpenQuery "qdelActuate_PAC_Entity", acViewNormal, acEdit
DoCmd.OpenQuery "qappPAC_EntityCurr"
BuildPACTable = True
BuildPACTable_Exit:
BuildPACTable = False
DoCmd.SetWarnings (True)
Exit Function
BuildPACTable_Err:
BuildPACTable = False
Select Case Err.Number
Case 3151
MsgBox Err.Number & ": " & "ODBC Connection Failure - Check
Password", vbCritical, "Build PAC Table Error"
Case Else
MsgBox Err.Number & ": " & Err.Description, vbCritical, "Build
PAC Table Error"
End Select
Resume BuildPACTable_Exit
End Function
called function returns True if successful, and False if there are errors.
If the called functions return False, I want to bail out on this sub. The
problem is, the error message associated with the called function is reported
twice. Other than the same message box appearing twice, everything works as
planned. How do I avoid the duplicate message boxes reporting the same error
(3151)?
Sub BuildTables()
Dim datStart As Date
Dim datEnd As Date
Dim lngLoop As Long
Dim Msg As String
Dim Ans As Integer
DoCmd.SetWarnings (False)
datStart = Now()
Call BuildPACTable
If BuildPACTable = True Then
If DCount("*", "qselUnassignedSiteID") > 0 Then
Forms!frmSwitchboard!cmdNewSite.Enabled = True
End If
Else
Exit Function
End If
datEnd = Now()
'Creates a message box
Msg = "Process completed successfully!"
Msg = Msg & vbNewLine & vbNewLine
Msg = Msg & "Process Time: " & DateDiff("n", [datStart], [datEnd]) & "
minutes"
Ans = MsgBox(Msg, vbInformation, "Refresh Status")
DoCmd.SetWarnings (True)
End Sub
The Called Function is this:
Function BuildPACTable()
On Error GoTo BuildPACTable_Err
DoCmd.SetWarnings (False)
DoCmd.OpenQuery "qdelActuate_PAC_Entity", acViewNormal, acEdit
DoCmd.OpenQuery "qappPAC_EntityCurr"
BuildPACTable = True
BuildPACTable_Exit:
BuildPACTable = False
DoCmd.SetWarnings (True)
Exit Function
BuildPACTable_Err:
BuildPACTable = False
Select Case Err.Number
Case 3151
MsgBox Err.Number & ": " & "ODBC Connection Failure - Check
Password", vbCritical, "Build PAC Table Error"
Case Else
MsgBox Err.Number & ": " & Err.Description, vbCritical, "Build
PAC Table Error"
End Select
Resume BuildPACTable_Exit
End Function