VBA/Excel/Access/Word/Access/Recordset

Материал из VB Эксперт
Перейти к: навигация, поиск

A Recordset That Does Not Support the RecordCount Property

   <source lang="vb">

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

</source>
   
  


A Recordset That Supports the RecordCount Property

   <source lang="vb">

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

</source>
   
  


Assigning Recordsets Dynamically to a form

   <source lang="vb">

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

</source>
   
  


Build a string text from result set

   <source lang="vb">

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

</source>
   
  


Creating a Custom Recordset

   <source lang="vb">

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

</source>
   
  


Creating a Disconnected Recordset

   <source lang="vb">

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

</source>
   
  


Dynamic Recordset

   <source lang="vb">

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

</source>
   
  


Filling a Combo Box with a Disconnected Recordset

   <source lang="vb">

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

</source>
   
  


Looping Through a Recordset

   <source lang="vb">

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

</source>
   
  


Move cursor in result set

   <source lang="vb">

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

</source>
   
  


Refreshing Recordset Data

   <source lang="vb">

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

</source>
   
  


Retrieve data from Recordset by table column name

   <source lang="vb">

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

</source>
   
  


Row order in Dynamic Recordset

   <source lang="vb">

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

</source>
   
  


Set Index and seek the recordset

   <source lang="vb">

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

</source>
   
  


Set recordset to form

   <source lang="vb">

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

</source>
   
  


Snapshot Recordset

   <source lang="vb">

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

</source>
   
  


The Sort Property of the Recordset Object

   <source lang="vb">

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

</source>
   
  


The Supports Method of the Recordset Object

   <source lang="vb">

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

</source>
   
  


Using the AbsolutePosition Property

   <source lang="vb">

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

</source>
   
  


Using the Bookmark Property

   <source lang="vb">

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

</source>
   
  


Using the EOF Property to Determine the Bounds of a Recordset

   <source lang="vb">

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

</source>
   
  


Whether Records Are Returned in a Recordset

   <source lang="vb">

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

</source>