'Step 1. Copy the sample data from the following link: :http://www.utexas.edu/courses/poynor/mis333k/sjdaoadorecordsets.html
'Step 2. Follow instructions at the link for making a table with the sample data
'Step 3. Import this file or copy and paste it into your modUtilities
'Step 4. Run the procedures below, make changes, run again, practice

Option Compare Database
Option Explicit
Private cnn As ADODB.Connection
Private rst As New ADODB.Recordset
'note to MIS333k class:
'see lines above: good "module-level" variables
'saves you having to Dim them in every proc
'saves you from opening the recordset, too

Public Sub CNN_Execute()
    ' note alternative syntax in sub below. This sub is NOT recordset programming.
    Dim strSQL As String
    Dim cmd As New ADODB.Command
    Set cnn = CurrentProject.Connection
    strSQL = "UPDATE tblPeople SET IsSelected=true WHERE IsSelected=false;"
    cnn.BeginTrans
        cmd.ActiveConnection = cnn
        cmd.CommandText = strSQL
        cmd.Execute
    cnn.CommitTrans
End Sub

Public Sub CurrentProject_Execute()
    ' note alternative syntax in sub above. This sub is NOT recordset programming.
    Dim strSQL As String
    Set cnn = CurrentProject.Connection
    strSQL = "UPDATE tblPeople SET IsSelected=true WHERE IsSelected=false;"
    cnn.BeginTrans
         CurrentProject.Connection.Execute strSQL
    cnn.CommitTrans
End Sub

Public Sub RST_Seek()
    Dim rst As New ADODB.Recordset
    Dim cnn As ADODB.Connection
    Set cnn = CurrentProject.Connection
    
    rst.Index = "LastNameIndex"  ' this index MUST be established (hard coded) in the table!!
    
    rst.Open "tblPeople", cnn, adOpenStatic, adLockOptimistic, adCmdTableDirect
    
    ' see p 521, 535, 570, 584 Novalis & Jones for SEEK information
    
    Dim strName As String, strWhich As String
    strWhich = "first: "
    strName = InputBox("Enter a last name")
    
    rst.Seek strName, adSeekFirstEQ

    Do Until strName <> rst!LastName   ' this loop works well bc the rst is in order by last name
            Debug.Print "Sought " & strWhich & rst!FirstName & " " & rst!LastName
            rst.MoveNext
            strWhich = "next: "
    Loop
End Sub

Private Sub RecordsetToArray()

'    Set cnn = CurrentProject.Connection
'    rst.Open "tblPeople", cnn, adOpenKeyset, adLockOptimistic, adCmdTable

    rst.Open "Select * FROM tblPeople ORDER BY LastName", CurrentProject.Connection, adOpenDynamic, adLockOptimistic, adCmdText
    rst.MoveLast
    Debug.Print "rst.MoveLast: Name of alphabetically last person in table is "; _
                      rst!FirstName, rst!LastName
    rst.MoveFirst
    Debug.Print "rst.MoveFirst: Name of alphabetically first person in table is "; _
                      rst!FirstName, rst!LastName

    Debug.Print "rst.RecordCount= "; CountRecords(rst)

    If rst.Supports(adAddNew) Then
        rst.AddNew
        rst!FirstName = "Hugh"
        rst!LastName = "Warrior"
        rst!HireDate = Now
        rst!Salary = 13000
        rst.Update
    Else
        Debug.Print "No addnew performed"
    End If
    If rst.Supports(adBookmark) Then Debug.Print "Supports Bookmarks" Else Debug.Print "Does not support Bookmarks"
    If rst.Supports(adAddNew) Then Debug.Print "Supports AddNew" Else Debug.Print "Does not support AddNew"
    If rst.Supports(adFind) Then Debug.Print "Supports Find" Else Debug.Print "Does not support Find"
    If rst.Supports(adDelete) Then Debug.Print "Supports Delete" Else Debug.Print "Does not support Delete"
    If rst.Supports(adMovePrevious) Then Debug.Print "Supports MovePrevious" Else Debug.Print "Does not support MovePrevious"

    rst.Close ' must remember to close recordsets!!!!
    Set rst = Nothing

End Sub

Public Sub RangeOfChoices()
' initialize the variables
Dim strChoice(1 To 3) As String
Dim intChoice As Integer
Dim intTrip As Integer
intChoice = 1
strChoice(1) = "the beach?"
strChoice(2) = "the mountains?"
strChoice(3) = "Philadelphia?"
' body of your logic
Do
    intTrip = MsgBox("Would you like to go to " & _
        strChoice(intChoice), vbYesNo, "This Summer")
    intChoice = (intChoice Mod 3) + 1
Loop Until intTrip = vbYes
End Sub

Public Function Sum()
    Dim intRow As Integer, intN As Integer
    Dim varDataSet As Variant
    Dim rst As New ADODB.Recordset
    Dim cnn As ADODB.Connection
    Set cnn = CurrentProject.Connection
    rst.Open "tblEmployee", cnn, adOpenForwardOnly, , adCmdTable
    varDataSet = rst.GetRows(999) ' 999 = number of records
    rst.Close
  For intRow = LBound(varDataSet, 2) To UBound(varDataSet, 2)
    Sum = Sum + varDataSet(5, intRow): intN = intN + 1
  Next
  Sum = IIf(intN > 0, Sum / intN, 0)
  Debug.Print "Average Amount=" & Format(Sum, "Currency")
End Function
Public Function NRecs(rs As ADODB.Recordset) As Integer
    rs.MoveFirst
    Do While Not rs.EOF
        rs.MoveNext
        NRecs = NRecs + 1
    Loop
End Function
Public Sub PrintNameSex()
    Dim rst As New ADODB.Recordset
    Dim cnn As ADODB.Connection
    Set cnn = CurrentProject.Connection
    Dim strSQL As String
    strSQL = "Select * from tblEmployee Order By HireDate"
    rst.Open strSQL, cnn, adOpenKeyset, , adCmdText
    Dim intIndex As Integer

    Debug.Print "Fields syntax (useful recordset properties) "
    For intIndex = 0 To rst.Fields.Count - 1
        Debug.Print intIndex, rst.Fields.Item(intIndex).Name, rst.Fields.Item(intIndex).Value
    Next

    Do Until rst.EOF
        Debug.Print rst!FirstName, rst!Sex
        rst.MoveNext
    Loop

    rst.Close
    Set rst = Nothing
End Sub

Public Sub RST_Find()
    Dim rst As New ADODB.Recordset
    Dim cnn As ADODB.Connection
    Set cnn = CurrentProject.Connection
    rst.Open "tblEmployee", cnn, adOpenDynamic, adLockBatchOptimistic, adCmdTable

    ' see p 503 Novalis & Jones

    Dim strName As String
    Dim strFind As String
    strName = InputBox("Enter a last name")
    strFind = "LastName=" & "'" & strName & "'"

    rst.Find strFind

    If rst.EOF = True Then
        Debug.Print "OOPS"
    Else
        Debug.Print "Found " & rst!FirstName & " " & rst!LastName
        Do Until rst.EOF
            rst.Find strFind, 1
            If rst.EOF = True Then
                Exit Do
            Else
                Debug.Print "Found again, " & strName & ", " & rst!FirstName & " " & rst!LastName
            End If
        Loop
    End If

    rst.MoveFirst
    rst.Find "pkID=6"
    If rst.EOF Or rst.BOF = True Then
        Debug.Print "Failed to find pkID=6"
    Else
        Debug.Print "Found: "; rst!pkID, rst!FirstName, rst!LastName
    End If

    rst.MoveFirst
    rst.Find "HireDate=" & #2/24/2000#
    If rst.EOF Or rst.BOF = True Then
        Debug.Print "Failed to find 2/24/2000"
    Else
        Debug.Print "Found: "; rst!HireDate, rst!FirstName, rst!LastName
    End If


    rst.Close
    Set rst = Nothing

End Sub
Public Sub RST_Seek()

    ' ONLY for server-side VBScript

    ' see p 505 Novalis & Jones

End Sub
Public Sub RST_Array()
    Dim rst As New ADODB.Recordset
    Dim cnn As ADODB.Connection
    Set cnn = CurrentProject.Connection
    rst.Open "tblEmployee", cnn, adOpenDynamic, adLockBatchOptimistic, adCmdTable
    ' see p 508 Novalis & Jones
    Dim varArray As Variant   ' not necessary to include ()
    Debug.Print "------------Only Salary field-----------"
    varArray = rst.GetRows(, , "Salary") ' get only salaries
    Debug.Print "cols="; LBound(varArray, 1); " to "; UBound(varArray, 1); " and rows="; LBound(varArray, 2); " to "; UBound(varArray, 2)
    Dim c As Integer, r As Integer
    For r = LBound(varArray, 2) To UBound(varArray, 2)
        For c = LBound(varArray, 1) To UBound(varArray, 1)
            Debug.Print "c="; c; " r="; r; " "; FormatCurrency(varArray(c, r));
        Next
        Debug.Print
    Next
    Debug.Print "c=0"; " r=0"; " "; FormatCurrency(varArray(0, 0))
    Debug.Print "c=0"; " r=1"; " "; FormatCurrency(varArray(0, 1))

    Debug.Print "-------Entire table-----------"
    rst.MoveFirst
    varArray = rst.GetRows ' get entire table
    Debug.Print "cols="; LBound(varArray, 1); UBound(varArray, 1); " and rows="; LBound(varArray, 2); UBound(varArray, 2)
    For r = LBound(varArray, 2) To UBound(varArray, 2)
        Debug.Print " r=";
        For c = LBound(varArray, 1) To UBound(varArray, 1)
            Debug.Print varArray(c, r); " ";
        Next
        Debug.Print
    Next
    rst.Close
    Set rst = Nothing
End Sub


Private Function CountRecords(rs As ADODB.Recordset) As Long
Dim varWhere As Variant

If rs.Supports(adBookmark) Then varWhere = rs.Bookmark Else Debug.Print "Bookmarks not possible."
rs.MoveFirst
Do While Not rs.EOF
    CountRecords = CountRecords + 1
    rs.MoveNext
Loop
If rs.Supports(adBookmark) Then rs.Bookmark = varWhere
End Function