Search code examples
vbams-accessadodbrecordset

Access VBA loop through a table to add new

This table matches column names of source table and destination table. enter image description here I would like to transfer records from the source table to the destination table as below.

    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

Is there a way of looping through the records from the matching table above so that I dont need to type all .Fields("Col_Sour").Value = Rs_Sour.Fields("Col_Dest")?

Solution

  • Yes, you can. One way would be to create a two dimensional array with the source and destination fields. I've modified your code to include this method. The myFields() array holds the field names. This will loop through all the field names in your field name table regardless of the number of fields listed.

        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

    The record count method in ADO has always been buggy to me. DAO seems easier to use for most of my recordset work. I've tested what I posted and it works.