Question

有没有办法在不使用VBA中的movelast方法的情况下获取记录集的行数？如果我尝试使用movelast方法，该函数将在我使用UDF时停止。

Answer 1

是的，但您必须open the Recordset using adOpenStatic。这会将整个Recordset拉入内存，因此如果您的应用程序不需要处理整个记录集，您需要查看其他用户所做的更改，或者它是否太大而无法放入内存中，这不是一个好主意。

rs.Open "source", , adOpenStatic
Debug.Print rs.RecordCount

Answer 2

此处http://www.geeksengine.com/article/recordcount-ado-recordset-vba.html的文章非常清楚地说明了这一问题。使用VBA在Recordset对象中获取正确的记录数问题涉及使用的光标。

简而言之，在设置后添加： rs =新的ADODB.Recordset

' Client-side cursor
rs.CursorLocation = adUseClient

Answer 3

如果有人对工作示例感兴趣：

'查询一个关闭的 Excel 工作簿并将一列分配给一个数组。

Sub TestADO()
    Dim MeArr() As Variant

    MeArr = ADOLoader ("C:\Closed_Workbook.xlsx", "Sheet1", "Column One")

    Debug.Print LBound(MeArr), MeArr(LBound(MeArr))
    Debug.Print UBound(MeArr), MeArr(UBound(MeArr))

End Sub

' SubIDCol is the column header
Function ADOLoader(strSourceFile As String, SheetName As String,         SubIDCol As String) As Variant
    Dim RowPlace, f As Integer
    Dim cn As Object, rs As Object, sql As String
    Dim ACount As Integer
    Dim SubIDArray() As Variant
  
    sql = "Select  [" & SubIDCol & "] from [" & SheetName & "$]"  

    '---Connecting to the Data Source---
    Set cn = CreateObject("ADODB.Connection")
    With cn
        .Provider = "Microsoft.ACE.OLEDB.12.0"
        .ConnectionString = "Data Source=" & strSourceFile & ";" & "Extended Properties=""Excel 12.0 Xml;HDR=YES"";"
        .CursorLocation = adUseClient
        .Open
        Set rs = .Execute(sql)
    End With
    
' If you wanted the Headers:  
'         For f = 0 To rs.Fields.Count - 1
'            On Error Resume Next
 '           .Cells(r, c + f).Formula = rs.Fields(f).Name
' Debug.Print rs.Fields(f).Name
'            On Error GoTo 0
'        Next f
    RowPlace = 0

    ACount = rs.RecordCount - 1
    ReDim SubIDArray(rs.RecordCount - 1)

        On Error Resume Next
        rs.MoveFirst
        On Error GoTo 0
        Do While Not rs.EOF
            For f = 0 To rs.Fields.Count - 1
            On Error Resume Next
                SubIDArray(RowPlace) = rs.Fields(f).Value
                RowPlace = RowPlace + 1
                
                On Error GoTo 0
            Next f
            rs.MoveNext
       Loop
   
    '---Clean up---
    rs.Close
    cn.Close
    Set cn = Nothing
    Set rs = Nothing

Debug.Print "Lower bound of array = " & LBound(SubIDArray)
Debug.Print "Upper bound of array = " & UBound(SubIDArray)

    ADOLoader = SubIDArray()

End Function

VBA中的记录集计数

3 个答案: