是的，可以。一种方法是使用源字段和目标字段创建二维数组。我已修改您的代码以包含此方法。 myFields（）数组保存字段名称。无论列出的字段数是多少，这都会循环遍历您的字段名表中的所有字段名。

    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在我的大多数记录集工作中似乎更易于使用。我已经测试了我发布的内容，并且可以正常工作。

这与Rs_MATC作为匹配表的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",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