在vba中从查询填充数组然后将数据插入表中

Posted 2023-05-07

【中文标题】在vba中从查询填充数组然后将数据插入表中

【英文标题】：In vba fill Array from QUery then insert the data into table

【发布时间】：2017-07-12 06:51:39

【问题描述】：

所以我想将查询结果插入到数组中，然后我将遍历数组以将新行插入到新表中。 这是我完成的代码：

Public cnn As New ADODB.Connection
Public db As DAO.Database

Public Sub SUD_Main()
    Set db = Access.Application.CurrentDb
    Set cnn = CurrentProject.Connection

     Refreash    
End Sub

Private Sub Refreash()
Dim DataArr() As String
    Dim p As Variant
    Dim sql As String
    Dim XDATA As New ADODB.Recordset
    Dim RDS As DAO.Recordset
    Set RDS = db.OpenRecordset("tbl_dets")

    sql = "SELECT DISTINCT NAME FROM Types_tbl WHERE NAME LIKE 'Rob%'"
    XDATA.Open sql, cnn, adOpenStatic

    '''
    '' HERE I WANT TO FILL DataArr FROM XDATA
    '''
    DataArr = XDATA.GetRows

    XDATA.Close
    For Each p In DataArr
        sql = "SELECT DISTINCT TID FROM Types_tbl WHERE NAME ='" & p & "'"
        XDATA .Open sql, cnn, adOpenStatic

       Do Until XDATA.EOF
       DoEvents 
           '''Inserting new records to tbl_dets
           RDS.AddNew
           RDS!Name = p
           RDS!TID= XDATA!TID
           RDS.Update
           XDATA.MoveNext
       Loop
       XDATA.Close
    Next
End Sub

那么我错过了什么？我认为错误在数组中，但不知道如何修复它。

【问题讨论】：

您遇到的错误是什么？

DataArr = XDATA.GetRows 上的类型不匹配

XDATA.GetRows ----- 将多个记录从 Recordset 对象复制到二维数组中，并且您正尝试将输出添加到字符串中。我想这可能是问题

我还有其他方法可以将记录添加到动态数组吗？

【参考方案1】：

您的代码大部分是有效的，但是您犯了一些错误。 GetRows 返回一个包含行号和字段的多维数组。因此，您不能将其放入字符串中。您需要使用类型变体的数组。

Private Sub Refreash()
    Dim DataArr() As Variant
    Dim p As Variant
    Dim sql As String
    Dim XDATA As New ADODB.Recordset
    Dim RDS As DAO.Recordset
    Set RDS = db.OpenRecordset("tbl_dets")

    sql = "SELECT DISTINCT NAME FROM Types_tbl WHERE NAME LIKE 'Rob%'"
    XDATA.Open sql, cnn, adOpenStatic

    '''
    '' HERE I WANT TO FILL DataArr FROM XDATA
    '''
    'Make sure XData fetches all records
    XData.MoveLast
    XData.MoveFirst
    DataArr = XDATA.GetRows

    XDATA.Close
    For Each p In PATTs
        sql = "SELECT DISTINCT TID FROM Types_tbl WHERE NAME ='" & p & "'"
        XDATA .Open sql, cnn, adOpenStatic

       Do Until XDATA.EOF
       DoEvents 
           '''Inserting new records to tbl_dets
           RDS.AddNew
           RDS!Name = p
           RDS!TID= XDATA!TID
           RDS.Update
           XDATA.MoveNext
       Loop
       XDATA.Close
    Next
End Sub

请注意，我对这个 sub 仍有一些不明白的地方，可能是因为它还没有完成，比如它在设置后没有在任何地方使用 DataArr 以及同时使用 ADO 和 DAO（我更喜欢在这种情况下只做 DAO）。

【讨论】：

我错过了写 PATTs 而不是 DataArr 所以而不是 For Each p In PATTs 它应该是 For Each p In DataArr