给4个数据库中表1输入相同的记录

Sub Command0_Click()
    Dim cn As New ADODB.Connection
    Dim rs As New ADODB.Recordset
    Dim Tr As String
    Dim cNstr As String
    Dim a() As String
    Tr = Me.Text3    '空格隔开
    Dim v As Long
    For v = 1 To 4
        cNstr = "Provider=Microsoft.Ace.OleDB.12.0;data Source=" & Application.CurrentProject.Path & "\存入" & v & ".accdb"
        cn.Open cNstr
        cn.Execute "delete from 表1"
        rs.Open "select * from 表1", cn, 3, 2
        ReDim a(0 To rs.Fields.Count - 1)
        rs.AddNew
        For i = 1 To rs.Fields.Count - 1
            If InStr(" " & Tr & " ", " " & i & " ") > 0 Then a(i) = i
            rs.Fields(i) = a(i)
        Next i
        rs.Update
        rs.Close
        cn.Close
    Next
    MsgBox "添加成功！"
End Sub