怎样用VBA代码把ACCESS中的某一数据表复制到别一ACCESS里

青见

我是通过EXCEL操作ACCESS数据库，现在想把数据库1中的表二的数据复制或追加到数据库2的表二中，两张表的结构完全一样，请各位高手帮忙，谢谢了！
我找的代码只能在同一数据库内进行复制或备份
Public Sub BF()
    Dim mydata As String
    Dim myTable As String
    Dim myCopyName As String
    Dim SQL As String
    Dim cnn As ADODB.Connection
    Dim rs As ADODB.Recordset
    mydata = ThisWorkbook.Path & "\1.mdb"
    myTable = "表"
    myCopyName = "新表"
    Set cnn = New ADODB.Connection
    With cnn
        .Provider = "microsoft.jet.oledb.4.0"
        .Open mydata
    End With
    On Error Resume Next
    SQL = "drop table " & myCopyName
    Set rs = cnn.Execute(SQL)
    On Error GoTo 0
    SQL = "select * into " & myCopyName & " from " & myTable
    Set rs = cnn.Execute(SQL)
     cnn.Close
    Set rs = Nothing
    Set cnn = Nothing
End Sub

[ 本帖最后由 青见 于 2011-6-23 10:52 编辑 ]

gongzl1981

一種笨辦法:
可以將第一表的選擇集,循環 insert 至第二個表中.

青见

能否给个代码提示，谢谢gongzl1981

zhaogang1960

有两种办法可以选择：
1，SQL法
连接数据库2——删除其中的数据表——用数据库1的查询生成新数据表
2，access对象法

青见

谢谢zhaogang1960！
只是我太菜了，能否给点代码

zhaogang1960

原帖由 青见 于 2011-6-23 11:15 发表
谢谢zhaogang1960！
只是我太菜了，能否给点代码

没有附件，你自己修改吧：
Sub Macro1() '引用Microsoft AD0 Ext 2.8 for DDL and Security
    Dim cnn As Object, SQL$
    Dim myCat As New ADOX.Catalog
    On Error Resume Next
    myCat.ActiveConnection = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & ThisWorkbook.Path & "\数据库2.mdb"
    myCat.Tables.Delete "数据表1"
    Set myCat = Nothing
    On Error GoTo 0
    Set cnn = CreateObject("adodb.connection")
    cnn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & ThisWorkbook.Path & "\数据库2.mdb"
    SQL = "select * into 数据表1 from [;database=" & ThisWorkbook.Path & "\数据库1.mdb].数据表1"
    cnn.Execute SQL
    MsgBox "将数据表复制到了数据库DB2.mdb", vbInformation
    cnn.Close
    Set cnn = Nothing
End Sub

青见

谢谢zhaogang1960！

青见

谢谢zhaogang1960！问题解决了

青见

谢谢谢谢zhaogang1960！的代码,要是数据库有密码应该怎样改写这句代码?

zhaogang1960

原帖由 青见 于 2011-6-27 10:02 发表
谢谢谢谢zhaogang1960！的代码,要是数据库有密码应该怎样改写这句代码?

请自己修改密码：
Sub Macro1() '引用Microsoft AD0 Ext 2.8 for DDL and Security
    Dim cnn As Object, SQL$
    Dim myCat As New ADOX.Catalog
    On Error Resume Next
    myCat.ActiveConnection = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & ThisWorkbook.Path & "\数据库2.mdb;Jet OLEDB:Database Password=123456"
    myCat.Tables.Delete "数据表1"
    Set myCat = Nothing
    On Error GoTo 0
    Set cnn = CreateObject("adodb.connection")
    cnn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & ThisWorkbook.Path & "\数据库2.mdb;Jet OLEDB:Database Password=123456"
    SQL = "select * into 数据表1 from [;database=" & ThisWorkbook.Path & "\数据库1.mdb].数据表1"
    cnn.Execute SQL
    MsgBox "将数据表复制到了数据库DB2.mdb", vbInformation
    cnn.Close
    Set cnn = Nothing
End Sub