VBA/Excel/Access/Word/Forms/Form Events

Assign form Recordset in its open action

 
Private Sub Form_Open(Cancel As Integer)
    Dim con As ADODB.Connection
    Dim myRecordset As ADODB.Recordset
    Dim strFrmNm As String
    
    Set myRecordset = New ADODB.Recordset
    myRecordset.CursorType = adOpenKeyset
    myRecordset.LockType = adLockOptimistic
    Set con = New ADODB.Connection
    con.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=C:\store.mdb;"
       
    myRecordset.Open "SELECT * FROM Employees", con
    Set Me.Recordset = myRecordset
    
    myRecordset.Close
    con.Close
    Set myRecordset = Nothing
    Set con = Nothing
End Sub

CancelEvent: DoCmd.CancelEvent()

 
Private Sub Form_BeforeUpdate(Cancel As Integer)
   If MsgBox("Are you sure you want to save changes to this record?", _
              vbYesNo Or vbInformation, "Confirm Upate") = vbNo Then
      DoCmd.CancelEvent
   End If
End Sub

Code for the Add Button

 
Private Sub cmdAdd_Click()
    "Add a new row to the recordset
    Me.Recordset.AddNew
    Me.Recordset("CompanyName") = "New Company"
    Me.Recordset.Update
    "Move to the row that was added
    Me.Bookmark = Me.Recordset.Bookmark
End Sub

Code for the Find Button

 
Private Sub cmdFind_Click()
    Dim strClientID As String
    Dim varBookmark As Variant
    varBookmark = Me.Recordset.Bookmark
    strClientID = InputBox("Enter Client ID of Client You Want to Locate")
    Me.Recordset.Find "ClientID = " & strClientID, Start:=1
    If Me.Recordset.EOF Then
        MsgBox "Client ID " & strClientID & " Not Found!!"
        Me.Recordset.Bookmark = varBookmark
    Else
        Me.Bookmark = Me.Recordset.Bookmark
    End If
End Sub

Code for the Move Next Button

 
Private Sub cmdNext_Click()
    Me.Recordset.MoveNext
     If Me.Recordset.EOF Then
        Me.Recordset.MovePrevious
        MsgBox "Already at Last Record!!"
    End If
    Me.Bookmark = Me.Recordset.Bookmark
End Sub

Code for the Move Previous Button

 
Private Sub cmdPrevious_Click()
    Me.Recordset.MovePrevious
    If Me.Recordset.BOF Then
        Me.Recordset.MoveNext
        MsgBox "Already at First Record!!"
    End If
    Me.Bookmark = Me.Recordset.Bookmark
End Sub

Deleting a Record

 
Private Sub cmdDelete_Click()
    "Ask user if he really wants to delete the row
    intAnswer = MsgBox("Are You Sure???", _
        vbYesNo + vbQuestion, _
        "Delete Current Record?")
    "If he responds yes, delete the row and
    "move to the next row
    If intAnswer = vbYes Then
        Me.Recordset.Delete
        Call cmdNext_Click
        Me.Refresh
    End If
End Sub

Form Before Update action

 
Private Sub Form_BeforeUpdate(Cancel As Integer)
    If IsNull(Me.txtContactFirstName) Or _
        IsNull(Me.txtContactLastName) Or _
        IsNull(Me.txtCompanyName) Or _
        IsNull(Me.txtPhoneNumber) Then
        MsgBox "The Contact First Name, " & vbCrLf & _
            "Contact Last Name, " & vbCrLf & _
            "Company Name, " & vbCrLf & _
            "And Contact Phone Must All Be Entered", _
            vbCritical, _
            "Canceling Update"
        Me.txtContactFirstName.SetFocus
        Cancel = True
    End If
End Sub

Form_Filter

 
Private Sub Form_Filter(Cancel As Integer, FilterType As Integer) 
    Select Case FilterType
        Case acFilterByForm
            MsgBox "You Just Selected Filter By Form"
        Case acFilterAdvanced
            MsgBox "You Are Not Allowed to Select Advanced Filter/Sort"
            Cancel = True
     End Select
End Sub

If the data in the form dirty

 
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
    "If the form is dirty and the user presses page up or
    "page down, ignore the keystroke
    If Me.Dirty Then
        If KeyCode = vbKeyPageDown Or _
           KeyCode = vbKeyPageUp Then
           KeyCode = 0
        End If
    End If
End Sub

IsLoad function

 
Sub m()
    If Not IsLoaded("frmClients") Then
        msgBox "You must load this form from the Projects form", _
            vbCritical, "Warning"
    End If
End Sub
Public Function IsLoaded(strFormName As String) As Boolean
    Const FORMOPEN = -1
    Const FORMCLOSED = 0
    If SysCmd(acSysCmdGetObjectState, acForm, strFormName) <> FORMCLOSED Then
        IsLoaded = True
    Else
        IsLoaded = False
    End If
End Function

Key down event

 
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
    If Me.Dirty Then
        If KeyCode = vbKeyPageDown Or _
           KeyCode = vbKeyPageUp Then
           KeyCode = 0
        End If
    End If
End Sub

The Load Event Assigning a Recordset Object to the Form

 
Private Sub Form_Load()
    Dim rst As ADODB.Recordset
    Set rst = New ADODB.Recordset
    rst.ActiveConnection = CurrentProject.Connection
    rst.CursorType = adOpenKeyset
    rst.CursorLocation = adUseClient
    rst.LockType = adLockOptimistic
    rst.Open "Select * from tblClients", Options:=adCmdText
    Set Me.Recordset = rst
End Sub

The Undo event executes before changes to a row are undone.

 
Private Sub Form_Undo(Cancel As Integer)
     If MsgBox("You Have Attempted to Undo Changes " & _
         "to the Current Row.  Would You Like to Proceed " & _
         "with the Undo Process?", _
         vbYesNo) = vbYes Then
         "If he responds yes, proceed with the undo
         Cancel = False
     Else
         "If he responds no, cancel the undo
         Cancel = True
     End If
End Sub

Writing the Form_Error Event Procedure

 
Private Sub Form_Error(DataErr As Integer, Response As Integer) 
    Dim custId As String 
    
    Const conDuplicateKey = 3022 
    
    If DataErr = conDuplicateKey Then 
        Response = acDataErrContinue 
        Debug.Print "Customer " & custId & " already exists." 
    End If 
End Sub

You can not only check how the filter was invoked, but you can also intercept the process when the filter is applied.

 
Private Sub Form_ApplyFilter(Cancel As Integer, ApplyType As Integer)
    Dim intAnswer As Integer
    If ApplyType = acApplyFilter Then
        intAnswer = MsgBox("You just selected the criteria: " & _
                         Chr(13) & Chr(10) & Me.Filter & _
                         Chr(13) & Chr(10) & "Are You Sure You Wish " & __
                         to Proceed?", vbYesNo + vbQuestion)
        If intAnswer = vbNo Then
            Cancel = True
        End If
    End If
End Sub