Private Function HandleButtonClick(intBtn As Integer)
' This function is called when a button is clicked.
' intBtn indicates which button was clicked.
'*************************************************************************************
'If this Routine is being called from the 'Main Switchboard', AND the
'Button Clicked is '1', User is attempting to Open the YaDa - YaDa Switchboard
If intBtn = 1 And Me.Caption = "Main Switchboard" Then
Dim strMsg As String
Dim strResponse As String
Const conPASSWORD As String = "ZeBrA"
strMsg = "A Password is required in order to Open the YaDa-YaDa Switchboard." & _
vbCrLf & vbCrLf & "Enter the Password in the space provided below, " & _
"being advised that the Password is Case Sensitive."
strResponse = InputBox$(strMsg, "Password Prompt")
If strResponse = "" Then Exit Function 'Cancel or OK with no entry
'Look for an 'exact match to ZeBrA (Case Sensitive)
If StrComp(conPASSWORD, strResponse, vbBinaryCompare) = 0 Then
'Allow Code to fall through and proceed
Else
MsgBox "The Password you entered (" & strResponse & ") is not correct!", _
vbCritical, "Incorrect Password"
Exit Function
End If
End If
'*************************************************************************************
' Constants for the commands that can be executed.
Const conCmdGotoSwitchboard = 1
Const conCmdOpenFormAdd = 2
Const conCmdOpenFormBrowse = 3
Const conCmdOpenReport = 4
Const conCmdCustomizeSwitchboard = 5
Const conCmdExitApplication = 6
Const conCmdRunMacro = 7
Const conCmdRunCode = 8
Const conCmdOpenPage = 9
' An error that is special cased.
Const conErrDoCmdCancelled = 2501
Dim con As Object
Dim rs As Object
Dim stSql As String
On Error GoTo HandleButtonClick_Err
' Find the item in the Switchboard Items table
' that corresponds to the button that was clicked.
Set con = Application.CurrentProject.Connection
Set rs = CreateObject("ADODB.Recordset")
stSql = "SELECT * FROM [Switchboard Items] "
stSql = stSql & "WHERE [SwitchboardID]=" & Me![SwitchboardID] & " AND [ItemNumber]=" & intBtn
rs.Open stSql, con, 1 ' 1 = adOpenKeyset
' If no item matches, report the error and exit the function.
If (rs.EOF) Then
MsgBox "There was an error reading the Switchboard Items table."
rs.Close
Set rs = Nothing
Set con = Nothing
Exit Function
End If
Select Case rs![Command]
' Go to another switchboard.
Case conCmdGotoSwitchboard
Me.Filter = "[ItemNumber] = 0 AND [SwitchboardID]=" & rs![Argument]
' Open a form in Add mode.
Case conCmdOpenFormAdd
DoCmd.OpenForm rs![Argument], , , , acAdd
' Open a form.
Case conCmdOpenFormBrowse
DoCmd.OpenForm rs![Argument]
' Open a report.
Case conCmdOpenReport
DoCmd.OpenReport rs![Argument], acPreview
' Customize the Switchboard.
Case conCmdCustomizeSwitchboard
' Handle the case where the Switchboard Manager
' is not installed (e.g. Minimal Install).
On Error Resume Next
Application.Run "ACWZMAIN.sbm_Entry"
If (Err <> 0) Then MsgBox "Command not available."
On Error GoTo 0
' Update the form.
Me.Filter = "[ItemNumber] = 0 AND [Argument] = 'Default' "
Me.Caption = Nz(Me![ItemText], "")
FillOptions
' Exit the application.
Case conCmdExitApplication
CloseCurrentDatabase
' Run a macro.
Case conCmdRunMacro
DoCmd.RunMacro rs![Argument]
' Run code.
Case conCmdRunCode
Application.Run rs![Argument]
' Open a Data Access Page
Case conCmdOpenPage
DoCmd.OpenDataAccessPage rs![Argument]
' Any other command is unrecognized.
Case Else
MsgBox "Unknown option."
End Select
' Close the recordset and the database.
rs.Close
HandleButtonClick_Exit:
On Error Resume Next
Set rs = Nothing
Set con = Nothing
Exit Function
HandleButtonClick_Err:
' If the action was cancelled by the user for
' some reason, don't display an error message.
' Instead, resume on the next line.
If (Err = conErrDoCmdCancelled) Then
Resume Next
'ElseIf Err.Number = -2147352560 Then 'Nothing
Else
MsgBox "There was an error executing the command." & Err.Number, vbCritical
Resume HandleButtonClick_Exit
End If
End Function
Comment