
'----------------------------------------------------------------
' Hands-On 13-1
'----------------------------------------------------------------

Sub ThreeRecordsetsDAO()
    Dim db As DAO.Database
    Dim tblRst As DAO.Recordset
    Dim dynaRst As DAO.Recordset
    Dim snapRst As DAO.Recordset
    
    Set db = OpenDatabase("C:\Acc07_ByExample\Northwind 2007.accdb")
    
    Set tblRst = db.OpenRecordset("Customers", dbOpenTable)
    Debug.Print "# of records in a table: " & tblRst.RecordCount
    
    Set dynaRst = db.OpenRecordset("Customers", dbOpenDynaset)
    Debug.Print "# of records in a Dynaset: " & dynaRst.RecordCount
    dynaRst.MoveLast
    Debug.Print "# of records in a Dynaset: " & dynaRst.RecordCount
    
    Set snapRst = db.OpenRecordset("Customers", dbOpenSnapshot)
    Debug.Print "# of records in a Snapshot: " & snapRst.RecordCount
    snapRst.MoveLast
    Debug.Print "# of records in a Snapshot: " & snapRst.RecordCount
    
    tblRst.Close
    dynaRst.Close
    snapRst.Close
    db.Close
    Set db = Nothing
    
    SendKeys "^g"
End Sub


'----------------------------------------------------------------
' Hands-On 13-2
'----------------------------------------------------------------

Sub OpenSnapshot()
    Dim db As DAO.Database
    Dim rst As DAO.Recordset
    
    Set db = OpenDatabase("C:\Acc07_ByExample\Northwind 2007.accdb")
    Set rst = db.OpenRecordset("Customers", dbOpenSnapshot)
    
    MsgBox "Current record: " & rst.AbsolutePosition + 1
    MsgBox "Number of records: " & rst.RecordCount
    rst.MoveLast
    MsgBox "Current record: " & rst.AbsolutePosition + 1
    MsgBox "Number of records: " & rst.RecordCount
    rst.Close
    Set rst = Nothing
    db.Close
    Set db = Nothing
End Sub


'----------------------------------------------------------------
' Hands-On 13-3
'----------------------------------------------------------------

Sub ReadFromEnd()
    Dim db As DAO.Database
    Dim rst As DAO.Recordset
    
    Set db = OpenDatabase("C:\Acc07_ByExample\Northwind 2007.accdb")
    Set rst = db.OpenRecordset("Customers", dbOpenTable)
    rst.MoveLast
    
    Do Until rst.BOF
        Debug.Print rst!Company
        rst.MovePrevious
    Loop
    
    SendKeys "^g"
    rst.Close
    Set rst = Nothing
    db.Close
    Set db = Nothing
End Sub


'----------------------------------------------------------------
' Hands-On 13-4
'----------------------------------------------------------------

Sub NavigateRecords()
    Dim db As DAO.Database
    Dim tblRst As DAO.Recordset
    Dim dynaRst As DAO.Recordset
    
    Set db = OpenDatabase("C:\Acc07_ByExample\Northwind 2007.accdb")
    Set tblRst = db.OpenRecordset("Employees")
    tblRst.MoveFirst
    
    Do While Not tblRst.EOF
        Debug.Print "Employee: " & tblRst![Last Name]
        tblRst.MoveNext
    Loop
    
    Set dynaRst = db.OpenRecordset("Employees", dbOpenDynaset)
    dynaRst.MoveFirst
    
    Do While Not dynaRst.EOF
        Debug.Print "Hello " & dynaRst![Last Name]
        dynaRst.MoveNext
    Loop
    
    tblRst.Close
    dynaRst.Close
    
    Set tblRst = Nothing
    Set dynaRst = Nothing
    db.Close
    Set db = Nothing
    SendKeys "^g"
End Sub


'----------------------------------------------------------------
' Hands-On 13-5
'----------------------------------------------------------------

Sub FindRecordsInTable()
    Dim db As DAO.Database
    Dim tblRst As DAO.Recordset
    
    Set db = OpenDatabase("C:\Acc07_ByExample\Northwind 2007.accdb")

    Set tblRst = db.OpenRecordset("Employees", dbOpenTable)
    ' find the first employee in the table whose name
    ' begins with the letter "K"
    
    tblRst.Index = "Last Name"
    tblRst.Seek ">=", "K"
    
    If Not tblRst.NoMatch Then
        MsgBox "Found the following employee: " & tblRst![Last Name]
    Else
        MsgBox "There is no employee with such a name."
    End If
    
    tblRst.Close
    Set tblRst = Nothing
    db.Close
    Set db = Nothing
End Sub


'----------------------------------------------------------------
' Hands-On 13-6
'----------------------------------------------------------------

Sub FindRecInDynaset()
    Dim db As DAO.Database
    Dim dynaRst As DAO.Recordset
    Dim mySpot As Variant
    
    Set db = OpenDatabase("C:\Acc07_ByExample\Northwind 2007.accdb")
    Set dynaRst = db.OpenRecordset("Employees", dbOpenDynaset)
    
    MsgBox "Current employee: " & dynaRst![Last Name]
    mySpot = dynaRst.Bookmark
    
    ' find clients whose name contains the string "Sp."
    dynaRst.FindFirst "[Last Name] Like '*er'"
    
    Do While Not dynaRst.NoMatch
        Debug.Print dynaRst![Last Name]
        dynaRst.FindNext "[Last Name] Like '*er'"
    Loop
    
    dynaRst.Bookmark = mySpot
    MsgBox "Back to record: " & dynaRst![Last Name]
    dynaRst.Close
      
    Set dynaRst = Nothing
    db.Close
    Set db = Nothing
    SendKeys "^g"
End Sub


'----------------------------------------------------------------
' Hands-On 13-7
'----------------------------------------------------------------

Sub FindNthRecord()
    Dim rst As DAO.Recordset
    Dim fld As DAO.Field
    Dim totalRec As Integer
    Dim nth As String
    
    Set db = OpenDatabase("C:\Acc07_ByExample\Northwind 2007.accdb")
    Set rst = db.OpenRecordset("Employees", dbOpenSnapshot)
    rst.MoveLast
    
    totalRec = rst.RecordCount
    rst.MoveFirst
    nth = InputBox("Enter the number of positions to move forward:")
    
    On Error Resume Next
    If totalRec > nth Then
        rst.Move nth
        For Each fld In rst.Fields
            Debug.Print fld.Name & ": " & fld.Value
        Next fld
    Else
        MsgBox "You must enter a value that is less than " _
            & totalRec & "."
    End If
    
    rst.Close
    Set rst = Nothing
    db.Close
    Set db = Nothing
End Sub


'----------------------------------------------------------------
' Hands-On 13-8
'----------------------------------------------------------------

' make sure to set up a reference to
' the Microsoft ActiveX Data Objects 2.8 Library

Sub OpenADORst()
    Dim conn As ADODB.Connection
    Dim rst As ADODB.Recordset
    
    Set conn = New ADODB.Connection
    With conn
       .Provider = "Microsoft.ACE.OLEDB.12.0"
       .Open "Data Source=" & CurrentProject.Path & _
           "\Northwind 2007.accdb"
    End With
    
    Set rst = New ADODB.Recordset
    With rst
       .Source = "SELECT * FROM Employees"
       .ActiveConnection = conn
       .Open
       Debug.Print rst.Fields.Count
       .Close
    End With
    
    Set rst = Nothing
    conn.Close
    Set conn = Nothing
End Sub


'----------------------------------------------------------------
' Code on page 306-308
'----------------------------------------------------------------

Sub ConnectAndExec()
   Dim conn As ADODB.Connection
   Dim rst As ADODB.Recordset

   Set conn = New ADODB.Connection
   conn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
      "Data Source=" & CurrentProject.Path & _
      "\Northwind.mdb"
   Set rst = conn.Execute("SELECT * FROM Employees")
   Debug.Print rst.Source
   rst.Close
   Set rst = Nothing
   conn.Close
   Set conn = Nothing
End Sub


Sub CommandAndExec()
   Dim conn As ADODB.Connection
   Dim cmd As ADODB.Command
   Dim rst As ADODB.Recordset

   Set conn = New ADODB.Connection
   With conn
        .ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
           "Data Source=" & CurrentProject.Path & "\Northwind.mdb"
           .Open
   End With

   Set cmd = New ADODB.Command
   With cmd
      .ActiveConnection = conn
      .CommandText = "SELECT * FROM Customers"
   End With

   Set rst = cmd.Execute

   MsgBox rst.Fields(1).Value

   rst.Close
   Set rst = Nothing
   conn.Close
   Set conn = Nothing
End Sub


Sub RecSetOpen()
   Dim rst As ADODB.Recordset
   Dim strConnection As String

   strConnection = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
      "Data Source=" & CurrentProject.Path & _
      "\Northwind.mdb"

   Set rst = New ADODB.Recordset
   With rst
      .Open "SELECT * FROM Customers", _
          strConnection, adOpenForwardOnly
      .Save CurrentProject.Path & "\MyRst.dat"
      .Close
   End With
   Set rst = Nothing
End Sub


'----------------------------------------------------------------
' Hands-On 13-9
'----------------------------------------------------------------

Sub OpenRst_TableOrQuery()
   Dim conn As ADODB.Connection
   Dim rst As ADODB.Recordset
  
   Set conn = New ADODB.Connection
    With conn
       .Provider = "Microsoft.ACE.OLEDB.12.0"
       .Open "Data Source=" & CurrentProject.Path & _
           "\Northwind 2007.accdb"
    End With
    
   Set rst = New ADODB.Recordset

   rst.Open "Employees", conn

   Debug.Print "CursorType: " & rst.CursorType & vbCr _
      & "LockType: " & rst.LockType & vbCr _
      & "Cursor Location: " & rst.CursorLocation

   Do Until rst.EOF
      Debug.Print rst.Fields(2)
      rst.MoveNext
   Loop
   
   rst.Close
   Set rst = Nothing
   conn.Close
   Set conn = Nothing
End Sub


'----------------------------------------------------------------
' Hands-On 13-10
'----------------------------------------------------------------

Sub CreateRst_WithSQL()
   Dim conn As ADODB.Connection
   Dim rst As ADODB.Recordset
   Dim strConn As String

   strConn = "Provider = Microsoft.ACE.OLEDB.12.0;" & _
      "Data Source=" & CurrentProject.Path & _
      "\Northwind 2007.accdb"

   Set conn = New ADODB.Connection
   conn.Open strConn

   Set rst = conn.Execute("SELECT * FROM Employees")
   Debug.Print rst("Last Name") & ", " & rst("First Name")

   rst.Close
   Set rst = Nothing
   conn.Close
   Set conn = Nothing
End Sub


'----------------------------------------------------------------
' Hands-On 13-11
'----------------------------------------------------------------

Sub OpenRst_WithCriteria()
   Dim conn As ADODB.Connection
   Dim rst As ADODB.Recordset
   Dim strConn As String

   strConn = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
      "Data Source=" & CurrentProject.Path & _
      "\Northwind 2007.accdb"

   Set conn = New ADODB.Connection
   conn.Open strConn

   Set rst = New ADODB.Recordset
   rst.Open "SELECT * FROM Employees WHERE [Job Title] = " & _
       "'Sales Representative'", _
       conn, adOpenForwardOnly, adLockReadOnly

   Do While Not rst.EOF
      Debug.Print rst.Fields(2).Value
      rst.MoveNext
   Loop

   rst.Close
   Set rst = Nothing
   conn.Close
   Set conn = Nothing
End Sub


'----------------------------------------------------------------
' Hands-On 13-12
'----------------------------------------------------------------

Sub OpenRst_Directly()
    Dim conn As ADODB.Connection
    Dim rst As ADODB.Recordset
    
    Set conn = New ADODB.Connection
    With conn
       .Provider = "Microsoft.ACE.OLEDB.12.0"
       .Open "Data Source=" & CurrentProject.Path & _
           "\Northwind 2007.accdb"
    End With
     
    Set rst = New ADODB.Recordset
    With rst
       .Source = "SELECT * FROM Employees"
       .ActiveConnection = conn
       .Open
    End With
    MsgBox rst.Fields(2)
    
    rst.Close
    Set rst = Nothing
    conn.Close
    Set conn = Nothing
End Sub


'----------------------------------------------------------------
' Hands-On 13-13
'----------------------------------------------------------------

Sub MoveAround()
   Dim conn As ADODB.Connection
   Dim rst As ADODB.Recordset
   Dim fld As ADODB.Field
   Dim strConn As String

   strConn = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
      "Data Source=" & CurrentProject.Path & _
      "\Northwind.mdb"

   Set conn = New ADODB.Connection
   conn.Open strConn

   Set rst = New ADODB.Recordset
   rst.Open "SELECT * FROM Customers where ContactTitle = 'Owner'", _
       conn, adOpenForwardOnly, adLockReadOnly
   Do While Not rst.EOF
      Debug.Print "New Record --------------"
      For Each fld In rst.Fields
         Debug.Print fld.Name & " = " & fld.Value
      Next
      rst.MoveNext
   Loop

   rst.Close
   Set rst = Nothing
   conn.Close
   Set conn = Nothing
End Sub


'----------------------------------------------------------------
' Hands-On 13-14
'----------------------------------------------------------------

Sub FindRecordPosition()
   Dim conn As ADODB.Connection
   Dim rst As ADODB.Recordset
   Dim strConn As String

   strConn = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
      "Data Source=" & CurrentProject.Path & _
      "\Northwind.mdb"

   Set conn = New ADODB.Connection
   conn.Open strConn

   Set rst = New ADODB.Recordset
   With rst
      .Open "SELECT * FROM Employees", conn, adOpenKeyset, _
          adLockOptimistic, adCmdText
   Debug.Print .AbsolutePosition
      .Move 3   ' move forward 3 records
      Debug.Print .AbsolutePosition
      .MoveLast ' move to the last record
      Debug.Print .AbsolutePosition
      Debug.Print .RecordCount
      .Close
   End With

   Set rst = Nothing
   conn.Close
   Set conn = Nothing
End Sub


'----------------------------------------------------------------
' Hands-On 13-15
'----------------------------------------------------------------


Sub ReadField()
    Dim conn As ADODB.Connection
    Dim rst As ADODB.Recordset
    
    Set conn = New ADODB.Connection
    With conn
       .Provider = "Microsoft.ACE.OLEDB.12.0"
       .Open "Data Source=" & CurrentProject.Path & _
           "\Northwind 2007.accdb"
    End With
    
    Set rst = New ADODB.Recordset
    rst.Open "SELECT * FROM Employees", conn, adOpenStatic
    
    Do While Not rst.EOF
      Debug.Print rst.Fields("Last Name").Value
      rst.MoveNext
    Loop
    
    rst.Close
    Set rst = Nothing
    conn.Close
    Set conn = Nothing
End Sub


'----------------------------------------------------------------
' Hands-On 13-16
'----------------------------------------------------------------

Sub GetRecords_AsString()
    Dim conn As ADODB.Connection
    Dim rst As ADODB.Recordset
    Dim varRst As Variant
    Dim fso As Object
    Dim myFile As Object
    
    Set conn = New ADODB.Connection
    With conn
       .Provider = "Microsoft.JET.OLEDB.4.0"
       .Open "Data Source=" & CurrentProject.Path & _
           "\Northwind.mdb"
    End With
    
    Set rst = New ADODB.Recordset
    rst.Open "SELECT EmployeeId, " & _
      "LastName & "", "" & FirstName as FullName " & _
      "FROM Employees", _
      conn, adOpenForwardOnly, adLockReadOnly, adCmdText
    
    If Not rst.EOF Then
      ' Return all rows as a formatted string with
      ' columns delimited by Tabs, and rows
      ' delimited by carriage returns
    
      varRst = rst.GetString(adClipString, , vbTab, vbCrLf)
      Debug.Print varRst
    End If
    
    ' save the recordset string to a text file
    Set fso = CreateObject("Scripting.FileSystemObject")
      Set myFile = fso.CreateTextFile(CurrentProject.Path & _
          "\RstString.txt", True)
    myFile.WriteLine varRst
    myFile.Close
    
    Set fso = Nothing
    rst.Close
    Set rst = Nothing
    conn.Close
    Set conn = Nothing
End Sub


'----------------------------------------------------------------
' Hands-On 13-17
'----------------------------------------------------------------

Sub Find_WithFind()
   Dim conn As ADODB.Connection
   Dim rst As ADODB.Recordset

   Set conn = New ADODB.Connection
   conn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
      "Data Source=" & CurrentProject.Path & _
      "\Northwind.mdb"

   Set rst = New ADODB.Recordset
   rst.Open "Employees", conn, adOpenKeyset, adLockOptimistic

   ' find the first record matching the criteria
   rst.Find "TitleOfCourtesy ='Ms.'"
   Do Until rst.EOF
      Debug.Print rst.Fields("LastName").Value
      ' search forward starting from the next record
      rst.Find "TitleOfCourtesy ='Ms.'", SkipRecords:=1, _
          SearchDirection:=adSearchForward
   Loop

   rst.Close
   Set rst = Nothing
   conn.Close
   Set conn = Nothing
End Sub


'----------------------------------------------------------------
' Hands-On 13-18
'----------------------------------------------------------------

Sub Find_WithSeek()
   Dim conn As ADODB.Connection
   Dim rst As ADODB.Recordset

   Set conn = New ADODB.Connection
   conn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
      "Data Source=" & CurrentProject.Path & _
      "\Northwind.mdb"

   Set rst = New ADODB.Recordset
   With rst
      .Index = "Region"
      .Open "Customers", conn, adOpenKeyset, adLockOptimistic, _
          adCmdTableDirect

      ' find out if this recordset supports the Seek method
      MsgBox rst.Supports(adSeek)
      .Seek "SP", adSeekFirstEQ
   End With

   If Not rst.EOF Then
      Debug.Print rst.Fields("CompanyName").Value
   End If

   rst.Close
   Set rst = Nothing
   conn.Close
   Set conn = Nothing
End Sub


'----------------------------------------------------------------
' Hands-On 13-19
'----------------------------------------------------------------

Sub Find_WithFilter()
   Dim conn As ADODB.Connection
   Dim rst As ADODB.Recordset

   Set conn = New ADODB.Connection
   conn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
      "Data Source=" & CurrentProject.Path & _
      "\Northwind.mdb"

   Set rst = New ADODB.Recordset
   rst.Open "Employees", conn, adOpenKeyset, adLockOptimistic
   rst.Filter = "TitleOfCourtesy ='Ms.' and Country ='USA'"
   Do Until rst.EOF
      Debug.Print rst.Fields("LastName").Value
      rst.MoveNext
   Loop

   rst.Close
   Set rst = Nothing
   conn.Close
   Set conn = Nothing
End Sub


'----------------------------------------------------------------
' Hands-On 13-20
'----------------------------------------------------------------

Sub TestBookmark()
    Dim conn As ADODB.Connection
    Dim rst As ADODB.Recordset
    Dim varMyBkmrk As Variant
    
    Set conn = New ADODB.Connection
    conn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
      "Data Source=" & CurrentProject.Path & _
      "\Northwind.mdb"
      
    Set rst = New ADODB.Recordset
    rst.Open "Employees", conn, adOpenKeyset
    
    If Not rst.Supports(adBookmark) Then
      MsgBox "This recordset does not support bookmarks!"
      Exit Sub
    End If
    
    varMyBkmrk = rst.Bookmark
    Debug.Print rst.Fields(1).Value
    
    ' Move to the 7th row
    rst.AbsolutePosition = 7
    Debug.Print rst.Fields(1).Value
    
    ' move back to the first row using bookmark
    rst.Bookmark = varMyBkmrk
    Debug.Print rst.Fields(1).Value
    rst.Close
    Set rst = Nothing
End Sub


'----------------------------------------------------------------
' Hands-On 13-21
'----------------------------------------------------------------

Sub Filter_WithBookmark()
   Dim rst As ADODB.Recordset
   Dim varMyBkmrk() As Variant
   Dim strConn As String
   Dim i As Integer
   Dim strCountry As String
   Dim strCity As String

   i = 0
   strCountry = "France"
   strCity = "Paris"

   strConn = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
      "Data Source=" & CurrentProject.Path & _
      "\Northwind.mdb"

   Set rst = New ADODB.Recordset
   rst.Open "Customers", strConn, adOpenKeyset

   If Not rst.Supports(adBookmark) Then
      MsgBox "This recordset does not support bookmarks!"
      Exit Sub
   End If

   Do While Not rst.EOF
      If rst.Fields("Country") = strCountry And _
         rst.Fields("City") = strCity Then
         ReDim Preserve varMyBkmrk(i)
         varMyBkmrk(i) = rst.Bookmark
         i = i + 1
      End If
      rst.MoveNext

   Loop

   rst.Filter = varMyBkmrk()

   rst.MoveFirst
   Do While Not rst.EOF
      Debug.Print rst("CustomerId") & _
         " - " & rst("CompanyName")
      rst.MoveNext
   Loop
   rst.Close
   Set rst = Nothing
End Sub


'----------------------------------------------------------------
' Hands-On 13-22
'----------------------------------------------------------------

Sub CountRecords()
    Dim conn As ADODB.Connection
    Dim rst As ADODB.Recordset
    Dim myarray As Variant
    Dim returnedRows As Integer
    Dim r As Integer 'record counter
    Dim f As Integer 'field counter
    
    Set conn = New ADODB.Connection
    conn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
       "Data Source=" & CurrentProject.Path & _
       "\Northwind.mdb"
    
    Set rst = New ADODB.Recordset
    rst.Open "SELECT * FROM Employees", _
       conn, adOpenForwardOnly, adLockReadOnly, adCmdText
    
    ' Return all rows into array
    myarray = rst.GetRows()
    returnedRows = UBound(myarray, 2) + 1
    
    MsgBox "Total number of records: " & returnedRows
    
    ' Find upper bound of second dimension
    For r = 0 To UBound(myarray, 2)
       Debug.Print "Record " & r + 1
       ' Find upper bound of first dimension
       For f = 0 To UBound(myarray, 1)
          ' Print data from each row in array
          Debug.Print Tab; _
             rst.Fields(f).Name & " = " & myarray(f, r)
       Next f
    Next r
    
    rst.Close
    Set rst = Nothing
    conn.Close
    Set conn = Nothing
End Sub


