Microsoft Access VBA Programming - ADO Recordset for The Beginners

Microsoft Access VBA Programming - ADO Recordset for The Beginners.

🎓 Master Visual Basic .NET and Access Database By Building the Point Of Sale System (POS).

📲 Enroll Now: https://bit.ly/2WcbRhX

What topics are included In this video tutorial?
- Open and Close Methods (ADO Connection and ADO Recordset)
- MoveFirst, MoveLast, MoveNext, and MovePrevious Methods
- Delete Method (ADO Recordset)
- Find Method (ADO)
- AbsolutePosition Property
- RecordCount Property
- BOF, EOF Properties
+Plus!
- Blinking Text Box
- Detect Key Pressed Event (Using Keyboard Navigation Keys : UP ARROW, DOWN ARROW, RIGHT ARROW And LEFT ARROW)

[YouTube]

Part 1: https://youtu.be/Bwbtva2uoWk
Part 2: https://youtu.be/Pj8XME9_fu0
Part 3: https://youtu.be/c77B3QR6T2A
Part 4: https://youtu.be/Tg9aCq8lA-c

[Read me]
Using ADO with Microsoft VB & VBA

[Source Code]

Option Compare Database
Dim iHide As Integer
Dim iBlink As Integer
Dim ForeColor As Long
Dim adoCon As ADODB.Connection
Dim adoRec As ADODB.Recordset

Private Sub cmdAddNew_Click()
DoCmd.GoToRecord , , acNewRec
txtShowMeTheWay = adoRec.RecordCount + 1 & " / " & adoRec.RecordCount + 1
End Sub

Private Sub cmdCancel_Click()
Me.Undo
End Sub

Private Sub cmdDelete_Click()
On Error GoTo ThisIsError

With adoRec
        If .RecordCount > 0 Then
                .Delete
                .MovePrevious
                ShowMeTheWay
        Else
                If Not (.EOF) Then
                        ShowMeTheWay
                ElseIf .EOF And .RecordCount > 0 Then
                        .MovePrevious
                        ShowMeTheWay
                ElseIf .EOF And .RecordCount <= 0 Then
                        txtShowMeTheWay = ""
                End If
        End If
End With

ErrorExit:
                Exit Sub
ThisIsError:
                    If Err.Number <> 0 Then
                            MsgBox "Error Number : " & Err.Number & vbCrLf & _
                            "Error Description : " & Err.Description, vbCritical, "Error Sir!"
                    Resume ErrorExit
                    End If
End Sub

Private Sub cmdExit_Click()
DoCmd.Close acForm, "Form1", acSavePrompt
End Sub

Private Sub cmdFind_Click()

If IsNull(txtFind) Or Len(txtFind & vbNullString) = 0 Then

    txtFind.SetFocus
    txtBlink.Value = "Please input Customer ID"
    iBlink = 0
    Me.TimerInterval = 500
   
Else

    adoRec.MoveFirst
    adoRec.Find "[ID] = '" & txtFind & "'", , adSearchForward
   
        If adoRec.EOF Then
            txtBlink.Value = "Sorry, Customer ID not found!"
            iBlink = 0
            Me.TimerInterval = 500
            txtFind.SetFocus
        Else
            txtBlink.Value = "^_^ Congratulations! ^_^"
            iBlink = 0
            Me.TimerInterval = 500
            ShowMeTheWay
        End If
End If

End Sub

Private Sub cmdFirst_Click()
On Error Resume Next
If Not (adoRec.BOF) Then adoRec.MoveFirst
If adoRec.RecordCount > 0 Then ShowMeTheWay
End Sub

Private Sub cmdLast_Click()
On Error Resume Next
adoRec.MoveLast
If adoRec.RecordCount > 0 Then ShowMeTheWay
End Sub

Private Sub cmdNext_Click()
On Error Resume Next
adoRec.MoveNext
If adoRec.EOF Then adoRec.MovePrevious
If adoRec.RecordCount > 0 Then ShowMeTheWay
End Sub

Private Sub cmdPrevious_Click()
On Error Resume Next
adoRec.MovePrevious
If adoRec.BOF Then adoRec.MoveNext
If adoRec.RecordCount > 0 Then ShowMeTheWay
End Sub

Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
Select Case KeyCode
    Case vbKeyLeft
        If (adoRec.AbsolutePosition = 1) Then
            iHide = 0
            Me.TimerInterval = 400
            Me.txtKeyDown.Value = "BOF Sir!"
        Else
            iHide = 0
            Me.TimerInterval = 400
            txtKeyDown = "Left (Previous)"
            Call cmdPrevious_Click
        End If
    Case vbKeyRight
        If (adoRec.AbsolutePosition = adoRec.RecordCount) Or (adoRec.EOF) Then
            iHide = 0
            Me.TimerInterval = 400
            Me.txtKeyDown.Value = "EOF Sir!"
        Else
            iHide = 0
            Me.TimerInterval = 400
            Me.txtKeyDown.Value = "Right (Next)"
            Call cmdNext_Click
        End If
    Case vbKeyUp
        iHide = 0
        Me.TimerInterval = 400
        txtKeyDown = "Up (First)"
        Call cmdFirst_Click
    Case vbKeyDown
         iHide = 0
        Me.TimerInterval = 400
        txtKeyDown = "Down (Last)"
        Call cmdLast_Click
    Case vbKeyF1
        KeyCode = 0
    Case Else
End Select
End Sub

Private Sub Form_Load()
KeyPreview = True
iHide = 0
iBlink = 0
Me.TimerInterval = 0
Set adoCon = New ADODB.Connection
Set adoRec = New ADODB.Recordset
adoCon.Open "Provider=MSDataShape; Data " & CurrentProject.AccessConnection
adoRec.Open "SELECT * FROM Customers", adoCon, adOpenKeyset, adLockOptimistic
Set Form.Recordset = adoRec

Me.txtName.ControlSource = "Customer name"
Me.txtJob.ControlSource = "Job Title"
Me.txtAddress.ControlSource = "Address"
Me.txtCity.ControlSource = "City"
Me.RecordSelectors = False
Me.txtShowMeTheWay.TextAlign = 2
txtFind.SetFocus
If adoRec.RecordCount > 0 Then ShowMeTheWay
End Sub

Private Sub ShowMeTheWay()
Dim Current As Long, Total As Long
Current = adoRec.AbsolutePosition
Total = adoRec.RecordCount
txtShowMeTheWay = Current & " / " & Total
End Sub

Private Sub Form_Timer()

iHide = iHide + 1
iBlink = iBlink + 1

Select Case iHide
    Case Is = 1
        txtKeyDown.Visible = True
    Case Is = 2
        txtKeyDown.Visible = True
    Case Else
        txtKeyDown.Visible = False
End Select

Select Case iBlink
    Case Is = 1, 5, 9
        txtBlink.Visible = True
        ForeColor = vbBlue
        txtBlink.ForeColor = ForeColor
    Case Is = 2, 4, 6, 8
        txtBlink.Visible = False
    Case Is = 3, 7
        txtBlink.Visible = True
        ForeColor = vbRed
        txtBlink.ForeColor = ForeColor
    Case Else
        txtBlink.Visible = False
        Me.TimerInterval = 0
        iBlink = 0
End Select

End Sub

Private Sub Form_Unload(Cancel As Integer)
adoRec.Close
Set adoRec = Nothing
adoCon.Close
Set adoCon = Nothing
End Sub

My Twitter

https://twitter.com/#!/IBasskung

My Facebook

https://www.facebook.com/CodeAMinute

My Google+

https://plus.google.com/u/0/107523775437712370629/posts

My YouTube Channel

http://www.youtube.com/user/TheRockmankung

Thank you very much.

ขอบคุณครับ.