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

青见 · 发表于 2011-6-27 10:20

数据库1也有密码

zhaogang1960 · 发表于 2011-6-27 10:57

原帖由青见于 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

青见 · 发表于 2011-6-27 11:06

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

zhaogang1960 · 发表于 2011-6-27 11:20

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

青见 · 发表于 2011-6-27 14:49

谢谢zhaogang1960
真是高手

danysy · 发表于 2013-8-16 20:08

值得学习了

yxqyxq · 发表于 2014-2-15 18:27

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

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

yxqyxq · 发表于 2014-2-15 19:14

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

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

zhaogang1960 · 发表于 2014-2-15 21:55

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

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

复制代码

zhaogang1960 · 发表于 2014-2-15 21:57

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

Sub Macro2()
Dim cnn As New ADODB.Connection
Dim rs As New ADODB.Recordset
Dim SQL As String
Dim myTable As String
On Error Resume Next
cnn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & ThisWorkbook.Path & "\数据库1.mdb"
Set rs = cnn.OpenSchema(adSchemaTables)
Do Until rs.EOF
If rs.Fields("TABLE_TYPE") = "TABLE" Then
myTable = "[Database=" & ThisWorkbook.Path & "\数据库2.mdb;]." & rs.Fields("TABLE_NAME")
SQL = "DROP TABLE " & myTable
cnn.Execute SQL
SQL = "SELECT * INTO " & myTable & " FROM " & rs.Fields("TABLE_NAME")
cnn.Execute SQL
End If
rs.MoveNext
Loop
MsgBox "已经将数据库1.mdb所有数据表复制到数据库2.mdb。", vbInformation
rs.Close
cnn.Close
Set rs = Nothing
Set cnn = Nothing
End Sub

复制代码

		自动登录	找回密码
密码			免费注册

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

评分

点评