VBA/Excel/Access/Word/Access/Recordset

A Recordset That Does Not Support the RecordCount Property

 
Sub CountRecordsBad()
    Dim rst As ADODB.Recordset
    Set rst = New ADODB.Recordset
    rst.ActiveConnection = CurrentProject.Connection
    rst.Open "Select * from Employees"
    Debug.Print rst.RecordCount  "Prints -1
    rst.Close
    Set rst = Nothing
End Sub

A Recordset That Supports the RecordCount Property

 
Sub CountRecordsGood()
    Dim rst As ADODB.Recordset
    Set rst = New ADODB.Recordset
    rst.ActiveConnection = CurrentProject.Connection
    rst.CursorType = adOpenStatic
    rst.Open "Select * from Employees"
    Debug.Print rst.RecordCount  "Prints Record count
    rst.Close
    Set rst = Nothing
End Sub

Assigning Recordsets Dynamically to a form

 
Sub runFormNY()
    Dim con As ADODB.Connection
    Dim myRecordset As 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:\mydb.mdb;"
       myRecordset.Open "SELECT * FROM Employees", con
       strFrmNm = "frmCustomer"
    DoCmd.OpenForm strFrmNm
    Set Application.Forms(strFrmNm).Recordset = myRecordset
    
    myRecordset.Close
    con.Close
    Set myRecordset = Nothing
    Set con = Nothing
End Sub

Build a string text from result set

 
Sub MyFirstConnection4()
    Dim myConnection As ADODB.Connection
    Dim myRecordset As ADODB.Recordset
    Dim strSQL As String
    Dim strOutput As String
   
    strSQL = "SELECT FirstName, LastName FROM Employees"
    
    Set myConnection = CurrentProject.Connection
    
    Set myRecordset = New ADODB.Recordset
    myRecordset.Open strSQL, myConnection
    
    Do Until myRecordset.EOF
       strOutput = strOutput + myRecordset.Fields("FirstName") & " " & _
                               myRecordset.Fields("LastName") & vbCrLf
       myRecordset.MoveNext
    Loop
    myRecordset.Close
    msgBox strOutput
    myConnection.Close
    Set myConnection = Nothing
    Set myRecordset = Nothing
End Sub

Creating a Custom Recordset

 
Sub Custom_Recordset()
    Dim myRecordset As ADODB.Recordset
    Dim strFile As String
    Dim strFolder As String
    strFolder = "C:\"
    strFile = Dir(strPath & "*.*")
    Set myRecordset = New ADODB.Recordset
    With myRecordset
       Set .ActiveConnection = Nothing
           .CursorLocation = adUseClient
           With .Fields
                     .Append "Name", adVarChar, 255
                     .Append "Size", adDouble
                     .Append "Modified", adDBTimeStamp
           End With
            .Open
              " Add a new record to the recordset
              .AddNew Array("Name", "Size", "Modified"), _
               Array("fileName.txt", 100, #9/9/1999#)
            .MoveFirst
             " Print the contents of the recordset to the Immediate window
                 Do Until .EOF
                      Debug.Print !Name & vbTab & !Size & vbTab & !Modified
                     .MoveNext
                 Loop
                 .Close
         End With
     Set myRecordset = Nothing
End Sub

Creating a Disconnected Recordset

 
Sub Rst_Disconnected()
    Dim conn As ADODB.Connection
    Dim myRecordset As ADODB.Recordset
    Dim strConn As String
    Dim strSQL As String
    Dim strRst As String
    strSQL = "Select * From Orders where CustomerID = "VINET""
    strConn = "Provider=Microsoft.Jet.OLEDB.4.0;"
    strConn = strConn & "Data Source = " & CurrentProject.Path & "\mydb.mdb"
    Set conn = New ADODB.Connection
    conn.ConnectionString = strConn
    conn.Open
    Set myRecordset = New ADODB.Recordset
    Set myRecordset.ActiveConnection = conn
    " retrieve the data
    myRecordset.CursorLocation = adUseClient
    myRecordset.LockType = adLockBatchOptimistic
    myRecordset.CursorType = adOpenStatic
    myRecordset.Open strSQL, , , , adCmdText
    Set myRecordset.ActiveConnection = Nothing
    myRecordset.MoveFirst
    Debug.Print myRecordset.Fields(0) & " was " & myRecordset.Fields(1) & " before."
    myRecordset.Fields("CustomerID").Value = "OCEAN"
    myRecordset.Update
    strRst = myRecordset.GetString(adClipString, , ",")
    Debug.Print strRst
End Sub

Dynamic Recordset

 
Sub exaRecordsetPosition()
    Dim db As Database
    Dim rsDyna As Recordset
    Set db = CurrentDb
    Set rsDyna = db.OpenRecordset("Books", dbOpenDynaset)
    rsDyna.MoveFirst
    Do While Not rsDyna.EOF
        Debug.Print rsDyna!PubID & " / " & rsDyna!Title
        Debug.Print rsDyna.AbsolutePosition
        Debug.Print Format$(rsDyna.PercentPosition
        rsDyna.MoveNext
    Loop
    rsDyna.Close
End Sub

Filling a Combo Box with a Disconnected Recordset

 
Private Sub Form_Load() 
   Dim myRecordset As ADODB.Recordset 
   Dim strRowSource As String 
   Dim strName As String 
   strName = CurrentProject.Path & "\Companies.rst" 
   Set myRecordset = New ADODB.Recordset 
      With myRecordset 
         .CursorLocation = adUseClient 
         .Open strName, , , ,  adCmdFile 
         Do Until .EOF 
            strRowSource = strRowSource & myRecordset!CompanyName & ";" 
            .MoveNext 
         Loop 
         With Me.cboCompany 
            .RowSourceType = "Value List" 
            .RowSource = strRowSource 
         End With 
         .Close 
      End With 
   Set myRecordset = Nothing 
End Sub

Looping Through a Recordset

 
Sub LoopThroughRecordset(rst As ADODB.Recordset, rg As Range) 
    Dim nColumnOffset As Integer 
    Dim fld As ADODB.Field 
    With rst 
        Do Until .EOF 
            nColumnOffset = 0 
            For Each fld In .Fields 
                rg.Offset(0, nColumnOffset).Value = fld.Value 
                nColumnOffset = nColumnOffset + 1 
            Next 
            Set rg = rg.Offset(1, 0) 
            .MoveNext 
        Loop 
    End With 
    Set fld = Nothing 
End Sub

Move cursor in result set

 
Sub MyFirstConnection3()
    Dim myConnection As ADODB.Connection
    Dim myRecordset As ADODB.Recordset
    Dim strSQL As String
    
    strSQL = "SELECT FirstName, LastName FROM Employees"
    Set myConnection = CurrentProject.Connection
    
    Set myRecordset = New ADODB.Recordset
    myRecordset.Open strSQL, myConnection
    
    Do Until myRecordset.EOF
       Debug.Print myRecordset.Fields("FirstName") & " " & _
                   myRecordset.Fields("LastName")
       myRecordset.MoveNext
    Loop
    myRecordset.Close
    myConnection.Close
    Set myConnection = Nothing
    Set myRecordset = Nothing
End Sub

Refreshing Recordset Data

 
Sub PersistRecordset()
    Dim strFileName As String
    strFileName = "c:\test.txt"
    Dim rst As ADODB.Recordset
    Set rst = New ADODB.Recordset
    rst.ActiveConnection = CurrentProject.Connection
    rst.CursorType = adOpenStatic
    rst.LockType = adLockOptimistic
    rst.Open Source:="Select * from Employees ", Options:=adCmdText
    On Error Resume Next
    Kill strFileName
    "Save the recordset
    rst.Save strFileName, adPersistADTG
    rst.Close
    Set rst = Nothing
End Sub

Retrieve data from Recordset by table column name

 
Sub MyFirstConnection()
    Dim myConnection As ADODB.Connection
    Dim myRecordset As ADODB.Recordset
    Set myConnection = CurrentProject.Connection
    
    Set myRecordset = New ADODB.Recordset
    myRecordset.Open "select * from employees", myConnection
    
    Do Until myRecordset.EOF
       Debug.Print myRecordset.Fields("FirstName"), _
                   myRecordset.Fields("LastName")
       myRecordset.MoveNext
    Loop
    myRecordset.Close
    myConnection.Close
    Set myConnection = Nothing
    Set myRecordset = Nothing
End Sub

Row order in Dynamic Recordset

 
Sub exaRecordsetMove()
    Dim db As Database
    Dim rsTable As Recordset
    Dim rsDyna As Recordset
    
    Set db = CurrentDb
    
    Set rsTable = db.OpenRecordset("Books")
    Debug.Print "Books indexed by PubID/Title:"
    
    rsTable.Index = "PubTitle"
    rsTable.MoveFirst
    Do While Not rsTable.EOF
        Debug.Print rsTable!PubID & " / " & rsTable!Title
        rsTable.MoveNext
    Loop
    
    Debug.Print "Dynaset-type recordset order:"
    Set rsDyna = db.OpenRecordset("Books", dbOpenDynaset)
    rsDyna.MoveFirst
    Do While Not rsDyna.EOF
        Debug.Print rsDyna!PubID & " / " & rsDyna!Title
        rsDyna.MoveNext
    Loop
    
    rsTable.Close
    rsDyna.Close
End Sub

Set Index and seek the recordset

 
Sub exaRecordsetSeek()
    Dim db As Database
    Dim rsTable As Recordset
    
    Set db = CurrentDb
    
    Set rsTable = db.OpenRecordset("Books")
    rsTable.Index = "Title"
    rsTable.Seek ">=", "On"
    If Not rsTable.NoMatch Then
        Debug.Print rsTable!Title
    Else
        Debug.Print "No title beginning with word "On"."
    End If
    
    rsTable.Close
End Sub

Set recordset to form

 
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 tblCustomer", con
    Set Me.Recordset = myRecordset
    
    myRecordset.Close
    con.Close
    Set myRecordset = Nothing
    Set con = Nothing
End Sub

Snapshot Recordset

 
Sub exaRecordsets()
    Dim db As Database
    Dim rsTable As Recordset
    Dim rsDyna As Recordset
    Dim rsSnap As Recordset
    Set db = CurrentDb
    Set rsTable = db.OpenRecordset("Employees")
    Debug.Print "TableCount: " & rsTable.RecordCount
    Set rsDyna = db.OpenRecordset("Employees", dbOpenDynaset)
    Debug.Print "DynaCount: " & rsDyna.RecordCount
    rsDyna.MoveLast
    Debug.Print "DynaCount: " & rsDyna.RecordCount
    
    Set rsSnap = db.OpenRecordset("Employees", dbOpenSnapshot)
    Debug.Print "SnapCount: " & rsSnap.RecordCount
    rsSnap.MoveLast
    Debug.Print "SnapCount: " & rsSnap.RecordCount
    
    rsTable.Close
    rsDyna.Close
    rsSnap.Close
    
End Sub

The Sort Property of the Recordset Object

 
Sub SortRecordset()
    Dim intCounter As Integer
    Dim rst As ADODB.Recordset
    Set rst = New ADODB.Recordset
    rst.ActiveConnection = CurrentProject.Connection
    rst.CursorLocation = adUseClient
    rst.Open "Select * from Employees"
    Debug.Print "NOT Sorted!!!"
    Do Until rst.EOF
        Debug.Print rst("EmployeeID")
        rst.MoveNext
    Loop
    Debug.Print "Now Sorted!!!"
    rst.Sort = "[EmployeeID]"
    Do Until rst.EOF
        Debug.Print rst("EmployeeID")
        rst.MoveNext
    Loop
    rst.Close
    Set rst = Nothing
End Sub

The Supports Method of the Recordset Object

 
Sub SupportsMethod()
    Dim rst As ADODB.Recordset
    Set rst = New ADODB.Recordset
    
    rst.ActiveConnection = CurrentProject.Connection
    rst.CursorType = adOpenStatic
    rst.LockType = adLockOptimistic
    rst.CursorLocation = adUseServer
    rst.Open Source:="Select * from Employees ", _
        Options:=adCmdText
    Debug.Print "Bookmark " & rst.Supports(adBookmark)
    Debug.Print "Update Batch " & rst.Supports(adUpdateBatch)
    Debug.Print "Move Previous " & rst.Supports(adMovePrevious)
    Debug.Print "Seek " & rst.Supports(adSeek)
    rst.Close
    Set rst = Nothing
End Sub

Using the AbsolutePosition Property

 
Sub FindPosition()
    Dim strSQL As String
    Dim rst As ADODB.Recordset
    Set rst = New ADODB.Recordset
    rst.ActiveConnection = CurrentProject.Connection
    rst.CursorType = adOpenStatic
    rst.Open "Select * from Products"
    strSQL = "[ProductID] = " & 1
    rst.Find strSQL
    "If record is found, print its position
    If rst.EOF Then
        msgBox lngValue & " Not Found"
    Else
        Debug.Print rst.AbsolutePosition
    End If
    rst.Close
    Set rst = Nothing
End Sub

Using the Bookmark Property

 
Sub UseBookmark()
    Dim strSQL As String
    Dim vntPosition As Variant
    Dim rst As ADODB.Recordset
    Set rst = New ADODB.Recordset
    rst.ActiveConnection = CurrentProject.Connection
    rst.CursorType = adOpenStatic
    rst.Open "Select * from Products"
    vntPosition = rst.Bookmark
    Do Until rst.EOF
        Debug.Print rst("ProductID")
        rst.MoveNext
    Loop
    rst.Bookmark = vntPosition
    Debug.Print rst("ProductID")
    rst.Close
    Set rst = Nothing

End Sub

Using the EOF Property to Determine the Bounds of a Recordset

 
Sub DetermineLimits()
    Dim rst As ADODB.Recordset
    Set rst = New ADODB.Recordset
    rst.ActiveConnection = CurrentProject.Connection
    rst.CursorType = adOpenStatic
    rst.Open "Select * from Employees"
    Do Until rst.EOF
        Debug.Print rst("EmployeeID")
        rst.MoveNext
    Loop
    rst.Close
End Sub

Whether Records Are Returned in a Recordset

 
Sub CheckARecordset()
    Dim rst As ADODB.Recordset
    Set rst = New ADODB.Recordset
    rst.ActiveConnection = CurrentProject.Connection
    rst.CursorType = adOpenStatic
    rst.Open "Select * from Employees"
    If Not rst.RecordCount Then
      msgBox "Recordset Empty...Unable to Proceed"
    End If
    rst.Close
    Set rst = Nothing
End Sub