Exemplo do método GetRows (VB)
Este exemplo usa o método GetRows para recuperar um número especificado de linhas de um Recordset e preencher uma matriz com os dados resultantes. O método GetRows retornará menos linhas do que o desejado em dois casos: se o EOF for atingido ou se GetRows tentar recuperar um registro que foi excluído por outro usuário. A função retornará False somente se o segundo caso ocorrer. A função GetRowsOK é necessária para que este procedimento seja executado.
'BeginGetRowsVB
'To integrate this code
'replace the data source and initial catalog values
'in the connection string
Public Sub Main()
On Error GoTo ErrorHandler
' connection and recordset variables
Dim rstEmployees As ADODB.Recordset
Dim Cnxn As ADODB.Connection
Dim strSQLEmployees As String
Dim strCnxn As String
' array variable
Dim arrEmployees As Variant
' detail variables
Dim strMessage As String
Dim intRows As Integer
Dim intRecord As Integer
' open connection
Set Cnxn = New ADODB.Connection
strCnxn = "Provider='sqloledb';Data Source='MySqlServer';" & _
"Initial Catalog='Pubs';Integrated Security='SSPI';"
Cnxn.Open strCnxn
' open recordset client-side to enable RecordCount
Set rstEmployees = New ADODB.Recordset
strSQLEmployees = "SELECT fName, lName, hire_date FROM Employee ORDER BY lName"
rstEmployees.Open strSQLEmployees, Cnxn, adOpenStatic, adLockReadOnly, adCmdText
' get user input for number of rows
Do
strMessage = "Enter number of rows to retrieve:"
intRows = Val(InputBox(strMessage))
' if bad user input exit the loop
If intRows <= 0 Then
MsgBox "Please enter a positive number", vbOKOnly, "Not less than zero!"
' if number of requested records is over the total
ElseIf intRows > rstEmployees.RecordCount Then
MsgBox "Not enough records in Recordset to retrieve " & intRows & " rows.", _
vbOKOnly, "Over the available total"
Else
Exit Do
End If
Loop
' else put the data in an array and print
arrEmployees = rstEmployees.GetRows(intRows)
Dim x As Integer, y As Integer
For x = 0 To intRows - 1
For y = 0 To 2
Debug.Print arrEmployees(y, x) & " ";
Next y
Debug.Print vbCrLf
Next x
' clean up
rstEmployees.Close
Cnxn.Close
Set rstEmployees = Nothing
Set Cnxn = Nothing
Exit Sub
ErrorHandler:
' clean up
If Not rstEmployees Is Nothing Then
If rstEmployees.State = adStateOpen Then rstEmployees.Close
End If
Set rstEmployees = Nothing
If Not Cnxn Is Nothing Then
If Cnxn.State = adStateOpen Then Cnxn.Close
End If
Set Cnxn = Nothing
If Err <> 0 Then
MsgBox Err.Source & "-->" & Err.Description, , "Error"
End If
End Sub
'EndGetRowsVB