通过 table 访问 VBA 循环以添加新的

Question

此 table 匹配源 table 和目标 table 的列名称。我想将记录从源 table 传输到目标 table，如下所示。

    Dim Con_Dest As New ADODB.Connection
    Dim Con_Sour As New ADODB.Connection
    Dim Rs_Sour As New ADODB.Recordset
    Dim Rs_Dest As New ADODB.Recordset

    Dim Str_SqlSour As String
    Dim Str_SqlDest As String

    Dim Str_Sql As String

    Con_Sour.Open "dsn=xxxx;uid=xxxx;pwd=xxxxx"
    Con_Dest.Open "dsn=yyyyy;uid=yyyyy;pwd=yyyyyy"

    Str_SqlSour = "select * from Table_Sour"

    Rs_Sour.Open Str_SqlSour, Con_Sour
    Rs_Dest.Open "Table_Dest", Con_Dest, adOpenDynamic, adLockOptimistic

    Rs_Sour.MoveFirst
    Do Until Rs_Sour.EOF

        With Rs_Dest
            .AddNew

            .Fields("AAA").Value = Rs_Sour.Fields("id")
            .Fields("AAB").Value = Rs_Sour.Fields("target_id")
            .Fields("AAC").Value = Rs_Sour.Fields("group_code")
            .....

            .Update
        End With

        Rs_Sour.MoveNext
    Loop

有没有一种方法可以循环遍历上面匹配的 table 的记录，这样我就不需要输入所有 .Fields("Col_Sour").Value = Rs_Sour.Fields("Col_Dest")？

Answer 1

是的，你可以。一种方法是创建一个包含源字段和目标字段的二维数组。我已经修改了您的代码以包含此方法。 myFields() 数组包含字段名称。这将遍历您的字段名称 table 中的所有字段名称，而不管列出的字段数量。

    Dim Con_Dest As New ADODB.Connection
    Dim Rs_Sour As New ADODB.Recordset
    Dim Rs_Dest As New ADODB.Recordset
    Dim Rs_Fields As New ADODB.Recordset, rsCount As Integer
    Dim myFields() As String

    Dim Str_SqlSour As String
    Dim Str_SqlDest As String

    Dim Str_Sql As String

    Con_Sour.Open "dsn=xxxx;uid=xxxx;pwd=xxxxx"
    Con_Dest.Open "dsn=yyyyy;uid=yyyyy;pwd=yyyyyy"


    rsCount = 0

    Rs_Fields.Open "matchingFields", Con_Dest

    Rs_Fields.MoveFirst
    Do Until Rs_Fields.EOF
        rsCount = rsCount + 1
        Rs_Fields.MoveNext
    Loop


    ReDim myFields(1 To rsCount, 1 To 2) As String



    i = 1

    Rs_Fields.MoveFirst
    Do Until Rs_Fields.EOF

        myFields(i, 1) = Rs_Fields.fields("col_sour").Value
        myFields(i, 2) = Rs_Fields.fields("col_dest").Value
        i = i + 1
        Rs_Fields.MoveNext
    Loop


    Str_SqlSour = "select * from Table_Sour"

    Rs_Sour.Open Str_SqlSour, Con_Sour
    Rs_Dest.Open "Table_Dest", Con_Dest, adOpenDynamic, adLockOptimistic

    Rs_Sour.MoveFirst
    Do Until Rs_Sour.EOF

        With Rs_Dest
            .AddNew

            For i = 1 To UBound(myFields)
                Rs_Dest.fields(myFields(i, 2)).Value = Rs_Sour.fields(myFields(i, 1)).Value
            Next i

            .Update
        End With

        Rs_Sour.MoveNext
    Loop

ADO 中的记录计数方法对我来说一直是错误的。对于我的大部分记录集工作，DAO 似乎更容易使用。我已经测试了我发布的内容并且有效。

Answer 2

这与 Rs_MATC 一起作为匹配 table 的 DAO 记录集。

Dim Con_Dest As New ADODB.Connection
Dim Con_Sour As New ADODB.Connection
Dim Rs_Sour As New ADODB.Recordset
Dim Rs_Dest As New ADODB.Recordset
Dim Rs_MATC As DAO.Recordset

Dim Str_SqlSour As String
Dim Str_SqlDest As String

Con_Sour.Open "dsn=xxxx;uid=xxxx;pwd=xxxx"
Con_Dest.Open "dsn=yyyy;uid=yyyy;pwd=yyyy"

Str_SqlSour = "select * from Table_Source"

Rs_Sour.Open Str_SqlSour, Con_Sour
Rs_Dest.Open "Table_Dest", Con_Dest, adOpenDynamic, adLockOptimistic

Set Rs_MATC = CurrentDb.OpenRecordset("select * from Table_Matching")

Rs_Sour.MoveFirst
Do Until Rs_Sour.EOF

    With Rs_Dest
        .AddNew

        Rs_MATC.MoveFirst
        Do Until Rs_MATC.EOF

            Rs_Dest.Fields(Rs_MATC.Fields("Col_Dest").Value).Value = Rs_Sour.Fields(Rs_MATC.Fields("Col_Sour").Value).Value

            Rs_MATC.MoveNext
        Loop

        .Update
    End With

    Rs_Sour.MoveNext
Loop

通过 table 访问 VBA 循环以添加新的

Access VBA loop through a table to add new

ms-access

vba

adodb

recordset