GetRows メソッドの例 (VB)

この例では、GetRows メソッドを使って、指定された数の行を Recordset から取得し、結果のデータを配列に格納します。GetRows メソッドは、2 つのケースにおいて、要求される行数よりも少ない数を返します。1 つは EOF に達した場合で、もう 1 つは GetRows が別のユーザーによって削除されたレコードを取得しようとした場合です。関数は、2 番目のケースが発生した場合にのみ、False を返します。このプロシージャを実行するには、GetRowsOK 関数が必要です。

Public Sub GetRowsX()

    Dim rstEmployees As ADODB.Recordset
    Dim strCnn As String
    Dim strMessage As String
    Dim intRows As Integer
    Dim avarRecords As Variant
    Dim intRecord As Integer

    ' Open recordset with names and hire dates from employee table.
        strCnn = "Provider=sqloledb;" & _
        "Data Source=srv;Initial Catalog=Pubs;User Id=sa;Password=; "
    Set rstEmployees = New ADODB.Recordset
    rstEmployees.Open "SELECT fName, lName, hire_date " & _
        "FROM Employee ORDER BY lName", strCnn, , , adCmdText

    Do While True
        ' Get user input for number of rows.
        strMessage = "Enter number of rows to retrieve."
        intRows = Val(InputBox(strMessage))

        If intRows <= 0 Then Exit Do

        ' If GetRowsOK is successful, print the results,
        ' noting if the end of the file was reached.
        If GetRowsOK(rstEmployees, intRows, _
                avarRecords) Then
            If intRows > UBound(avarRecords, 2) + 1 Then
                Debug.Print "(Not enough records in " & _
                    "Recordset to retrieve " & intRows & _
                    " rows.)"
            End If
            Debug.Print UBound(avarRecords, 2) + 1 & _
                " records found."

            ' Print the retrieved data.
            For intRecord = 0 To UBound(avarRecords, 2)
                Debug.Print "  " & _
                    avarRecords(0, intRecord) & " " & _
                    avarRecords(1, intRecord) & ", " & _
                    avarRecords(2, intRecord)
            Next intRecord
        Else
            ' Assuming the GetRows error was due to data 
            ' changes by another user, use Requery to
            ' refresh the Recordset and start over.
            If MsgBox("GetRows failed--retry?", _
                    vbYesNo) = vbYes Then
                rstEmployees.Requery
            Else
                Debug.Print "GetRows failed!"
                Exit Do
            End If
        End If

        ' Because using GetRows leaves the current 
        ' record pointer at the last record accessed, 
        ' move the pointer back to the beginning of the 
        ' Recordset before looping back for another search.
        rstEmployees.MoveFirst
    Loop

    rstEmployees.Close

End Sub

Public Function GetRowsOK(rstTemp As ADODB.Recordset, _
    intNumber As Integer, avarData As Variant) As Boolean

    ' Store results of GetRows method in array.
    avarData = rstTemp.GetRows(intNumber)
    ' Return False only if fewer than the desired 
    ' number of rows were returned, but not because the 
    ' end of the Recordset was reached.
    If intNumber > UBound(avarData, 2) + 1 And _
            Not rstTemp.EOF Then
        GetRowsOK = False
    Else
        GetRowsOK = True
    End If

End Function