Доступ к VBA l oop через таблицу, чтобы добавить новый

Question

Эта таблица соответствует именам столбцов исходной таблицы и таблицы назначения. Я хотел бы перенести записи из исходной таблицы в таблицу назначения, как показано ниже.

    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

Существует ли способ циклического просмотра записей из соответствующей таблицы выше, так что мне не нужно вводить все .Fields("Col_Sour").Value = Rs_Sour.Fields("Col_Dest")?

Answer 1

Это работало с Rs_MAT C в качестве набора записей 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

Answer 2

Да, вы можете. Один из способов - создать двумерный массив с полями источника и назначения. Я изменил ваш код, чтобы включить этот метод. Массив myFields () содержит имена полей. Это будет l oop через все имена полей в вашей таблице имен полей, независимо от количества перечисленных полей.

    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 кажется более простым в использовании для большинства моих записей. Я проверил то, что я отправил, и это работает.