в 16:33, 26 мая 2010

2010-05-26T16:33:00Z

Admin: 1 версия

2010-05-26T12:47:01Z

1 версия

Новая страница

==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>

← Предыдущая	Версия 16:33, 26 мая 2010
(нет различий)

VBA/Excel/Access/Word/Access/Recordset - История изменений

в 16:33, 26 мая 2010

Admin: 1 версия