Question

我目前正在使用Excel VBA和SQL查询。我试图将我放入记录集中的内容转储到二维数组中，因此我可以在函数的后续部分中使用该信息。问题是我只知道两种从记录集中提取信息的方法：CopyFromRecordset和rs.Fields。

这是我正在尝试的代码。

Dim ID_Array(150, 2) As String
Set rs = New ADODB.Recordset
Set oConn = New ADODB.Connection

strSql = "select id, name from groups"
rs.Open strSql, oConn

Do While Not rs.EOF
    With ActiveSheet
     For Index = 0 To 171
        ID_Array(Index, 0) = CStr(rs.Fields(0).Value)

        'Safety check to make sure the value isn't null (was having problems before)
        If rs.Fields(1).Value <> Null Then
            ID_Array(Index, 1) = CStr(rs.Fields(1).Value)
        End If

    rs.MoveNext
    Next
    End With
Loop
rs.Close

我是正面的我没有正确地分配这些值，因为当我从记录集中取出它们时，很多都是错误的或没有出现（名称部分，特别是，甚至不会显示为MsgBox命令上的字符串，所以我假设没有正确分配它。

任何人都有这方面的经验吗？如何将rs的id部分分配给ID_Array的第一个维度，将rs的名称部分分配给ID_Array的第二个维度？

Answer 1

如果您使用ADODB.Recordset，则接下来不需要内循环。

尝试使用此代码，应该可以工作：

Dim ID_Array() As String
Set rs = New ADODB.Recordset
Set oConn = New ADODB.Connection

strSql = "select id, name from groups"
rs.Open strSql, oConn

Index = 0
Do While Not rs.EOF
    'With ActiveSheet
     'For Index = 0 To 171 you dont need for..next, Do While Not rs.EOF show you record one by one
        ReDim Preserve ID_Array(1, Index) 
        ID_Array(0, Index) = CStr(rs.Fields(0).Value)

        'Safety check to make sure the value isn't null (was having problems before)
        If rs.Fields(1).Value <> vbNullString Then
            ID_Array(1, Index) = CStr(rs.Fields(1).Value)
        End If
    Index = Index + 1
    rs.MoveNext
    'Next
    'End With
Loop
rs.Close
End Sub

Answer 2

我看到这是很久以前的，但我修改了它以使其更适合我，所以我希望它对其他人有用。

Function RecordSetArray(comTxt As String) As Variant
Dim ID_Array() As Variant
Dim objMyConn As ADODB.Connection, objMyCmd As ADODB.Command, rs As ADODB.Recordset
Set objMyConn = New ADODB.Connection: Set objMyCmd = New ADODB.Command: Set rs = New ADODB.Recordset

    'Open Connection'
objMyConn.ConnectionString = ConnectionString: objMyConn.Open

    'Set and Excecute SQL Command'
Set objMyCmd.ActiveConnection = objMyConn
With objMyCmd
    .CommandText = "SET NOCOUNT ON " & comTxt
    .CommandType = adCmdText: .Execute
End With
Set rs.source = objMyCmd:  rs.CursorLocation = adUseClient:      rs.Open

If rs.EOF Then
   FindRecordCount = 0
Else
   FindRecordCount = rs.RecordCount
End If

ReDim Preserve ID_Array(FindRecordCount - 1, rs.fields.count - 1)

Index = 0
Do While Not rs.EOF
    For i = 0 To rs.fields.count - 1
        ID_Array(Index, i) = rs.fields(i).Value
    Next
    Index = Index + 1
    rs.MoveNext
Loop
rs.Close: Set objMyConn = Nothing: Set objMyCmd = Nothing: Set rs = Nothing
RecordSetArray = ID_Array
End Function

Answer 3

要避免NULL错误，请更新您的查询以包含NVL函数并替换为空格。修剪你的.Value，你应该全力以赴。请注意，替换为空白字符串[＆＃39;＆＃39;]不起作用。另外，请注意所需的格式化数据库字段，例如日期。如果不是匹配格式，您将替换值将出错。

NVL(SQL_FieldName,' ')为New_SQL_FieldName

如何将记录集值分配给二维数组

3 个答案: