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

青见

数据库1也有密码

zhaogang1960

原帖由 青见 于 2011-6-27 10:20 发表
数据库1也有密码

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 [;pwd=123456;database=" & ThisWorkbook.Path & "\数据库1.mdb].数据表1"
    cnn.Execute SQL
    MsgBox "将数据表复制到了数据库DB2.mdb", vbInformation
    cnn.Close
    Set cnn = Nothing
End Sub

青见

谢谢zhaogang1960 老师!问题解决了.
只是摘不清[;pwd=123456;database=" & ThisWorkbook.Path & "\数据库1.mdb].数据表1"
这是的Password=123456为什么要用Pwd=123456呢

zhaogang1960

这个问题问得好，其实我也不知道，试了很多方法不行，才猜想起来数据库还有一种连接方式：
cnn.Open "DBQ=" & ThisWorkbook.Path & "\数据库1.mdb; Pwd=123456;DefaultDir=;DRIVER={Microsoft Access Driver (*.mdb)};"
用了这个果然可以，看来非连接数据库只能采用这种方式了

青见

谢谢zhaogang1960
真是高手

danysy

值得学习了

yxqyxq

zhaogang1960 发表于 2011-6-27 11:20
这个问题问得好，其实我也不知道，试了很多方法不行，才猜想起来数据库还有一种连接方式：
cnn.Open "DBQ= ...

zhaogang1960老师：如果是数据库2.mdb中所有数据表复制到SQL SERVER中呢？

yxqyxq

yxqyxq 发表于 2014-2-15 18:27
zhaogang1960老师：如果是数据库2.mdb中所有数据表复制到SQL SERVER中呢？

zhaogang1960老师：如果是数据库1.mdb中所有数据表复制到数据库2.mdb中呢

zhaogang1960

yxqyxq 发表于 2014-2-15 19:14
zhaogang1960老师：如果是数据库1.mdb中所有数据表复制到数据库2.mdb中呢

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

复制代码

zhaogang1960

上面代码没有判断数据库2.mdb数据表是否已经存在，下面代码直接删除可能存在的同名数据表

1. Sub Macro2()
   
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"
   
8.     Set rs = cnn.OpenSchema(adSchemaTables)
   
9.     Do Until rs.EOF
   
10.         If rs.Fields("TABLE_TYPE") = "TABLE" Then
    
11.             myTable = "[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
    

复制代码