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

zhaogang1960

考虑数据库有密码

1. Sub Macro3() '数据库带密码
   
2.     Dim cnn As New ADODB.Connection
   
3.     Dim rs As New ADODB.Recordset
   
4.     Dim SQL As String
   
5.     Dim myTable As String
   
6.     On Error Resume Next
   
7.     cnn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & ThisWorkbook.Path & "\数据库1.mdb;Jet OLEDB:Database Password=123456"
   
8.     Set rs = cnn.OpenSchema(adSchemaTables)
   
9.     Do Until rs.EOF
   
10.         If rs.Fields("TABLE_TYPE") = "TABLE" Then
    
11.             myTable = "[;pwd=123456;Database=" & ThisWorkbook.Path & "\数据库2.mdb;]." & rs.Fields("TABLE_NAME")
    
12.             SQL = "DROP TABLE " & myTable
    
13.             cnn.Execute SQL
    
14.             SQL = "SELECT * INTO " & myTable & " FROM " & rs.Fields("TABLE_NAME")
    
15.             cnn.Execute SQL
    
16.         End If
    
17.         rs.MoveNext
    
18.     Loop
    
19.     MsgBox "已经将数据库1.mdb所有数据表复制到数据库2.mdb。", vbInformation
    
20.     rs.Close
    
21.     cnn.Close
    
22.     Set rs = Nothing
    
23.     Set cnn = Nothing
    
24. End Sub
    

复制代码

yxqyxq

zhaogang1960 发表于 2014-2-15 22:10
考虑数据库有密码

谢谢zhaogang1960老师！号召全体VBA民向赵老师学习！

jjmysjg

zhaogang1960 发表于 2014-2-15 22:10
考虑数据库有密码

版主功底太深，望尘莫及。只有敬佩

renahu

zhaogang1960 发表于 2014-2-15 21:57
上面代码没有判断数据库2.mdb数据表是否已经存在，下面代码直接删除可能存在的同名数据表

赵老师，使用您这段代码，虽然可以把所有表考到另一个数据库中，但是拷贝之前的删除操作报错

creatorzxz

zhaogang1960 发表于 2014-2-15 21:57
上面代码没有判断数据库2.mdb数据表是否已经存在，下面代码直接删除可能存在的同名数据表

非常感谢，终于找到啦