VBA/Excel/Access/Word/Access/Recordset — различия между версиями
Admin (обсуждение | вклад) м (1 версия) |
|
(нет различий)
|
Версия 16:33, 26 мая 2010
Содержание
- 1 A Recordset That Does Not Support the RecordCount Property
- 2 A Recordset That Supports the RecordCount Property
- 3 Assigning Recordsets Dynamically to a form
- 4 Build a string text from result set
- 5 Creating a Custom Recordset
- 6 Creating a Disconnected Recordset
- 7 Dynamic Recordset
- 8 Filling a Combo Box with a Disconnected Recordset
- 9 Looping Through a Recordset
- 10 Move cursor in result set
- 11 Refreshing Recordset Data
- 12 Retrieve data from Recordset by table column name
- 13 Row order in Dynamic Recordset
- 14 Set Index and seek the recordset
- 15 Set recordset to form
- 16 Snapshot Recordset
- 17 The Sort Property of the Recordset Object
- 18 The Supports Method of the Recordset Object
- 19 Using the AbsolutePosition Property
- 20 Using the Bookmark Property
- 21 Using the EOF Property to Determine the Bounds of a Recordset
- 22 Whether Records Are Returned in a 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