Friday, November 4, 2011

Capturing a list box error in MS Access.

There are several places in KIDB where the user can select from a list box and then click a button to perform an action on the selection. A good example of this is you can select a box from the list box on the Box Location form and click a button to move it, that is to assign it a new address in the stacks. A potential problem with this is if someone clicks the button without first selecting a row in the list box, which chokes the code. Here is how I capture that error in the On Click event of the Move Box button:

Private Sub cmdMoveBox_Click()
On Error GoTo Err_cmdMoveBox_Click

'Sub allows user to move a box from one address to another.
'Limits ability to move boxes to users with a permission level of 3 or higher.

     Dim strDocName As String
     Dim strLinkCriteria As String
     Dim lst As Access.ListBox
     Set lst = Me.BoxList
     Dim intUser As Integer

     strDocName = "frmBoxMove"

     'Check for user authorization to delete boxes.
     intUser = Nz(DLookup("[Level]", "tluUsers", "[UserID]= '" & Environ("username") & "'"))

     If intUser > 2 Then
          'Check to see if any boxes have been selected.
          If lst.ItemsSelected.Count = 0 Then
               'Let the user know what is wrong.
               MsgBox "No box has been selected to move."
               'Exit the sub.
               Exit Sub
          'Check that no more than 1 box has been selected.
          ElseIf lst.ItemsSelected.Count > 1 Then
               'Let the user know what is wrong.
               MsgBox "Please select only one box to move."
               'Clear the listbox selections.
               lst.ListIndex = -1
               'Exit the sub.
               Exit Sub
          'If only one box is selected open the move box form.
               strLinkCriteria = "[BoxID]=" & Me!BoxList.Column(11)
               DoCmd.OpenForm strDocName, , , strLinkCriteria
          End If
          MsgBox "Sorry, you are not authorized to move boxes."
     End If

Exit Sub

MsgBox Err.Description
Resume Exit_cmdMoveBox_Click

End Sub

No comments:

Post a Comment