请帮忙编个宏，将EXCEL的数据一次性粘贴至ACCESS表内

michelle.shao · 发表于 2014-4-4 18:37

请各位帮忙编个宏，能自动将EXCEL的每列数据粘贴至ACCESS表内，谢谢！
因为不能使用ACCESS外部数据导入的功能，所以想把EXCEL 的数据直接粘贴到表内。我的附件只是列了几列和几行，其实有很多列和很多行的数据，想把内容一次性粘贴到ACCESS的表内，我试了下，手工只能一列一列的粘贴,太烦了,EXCEL录制宏我会,可是在ACCESS中要怎么编就不懂了,请各位帮忙解决，万分谢谢！

zhaogang1960 · 发表于 2014-4-5 23:37

第一步：检查是否存在Access数据库文件：

Private Sub Workbook_Open() ' 如果Access数据库文件不存在，则创建Access数据库及数据表
' 引用Microsoft ActiveX Data Objects 2.8 Library
' 引用Microsoft ADO Ext. 2.8 for DDL and Security
Dim Cat As New ADOX.Catalog
Dim myPath As String
Dim myTable As String
Dim SQL As String
myPath = ThisWorkbook.Path & "\数据库.mdb"
If Dir(myPath) <> "" Then Exit Sub
myTable = "数据表"
Cat.Create "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & myPath
SQL = "CREATE TABLE " & myTable _
& "(发票号 text(20),金额 DOUBLE,税额 DOUBLE,总额 DOUBLE)"
Cat.ActiveConnection.Execute SQL
Set Cat = Nothing
End Sub

复制代码

zhaogang1960 · 发表于 2014-4-5 23:39

Sub 将EXCEL的数据一次性粘贴至ACCESS表内() '从Excel工作表中向数据表添加纪录
' 引用Microsoft ActiveX Data Objects 2.8 Library
' 引用Microsoft ADO Ext. 2.8 for DDL and Security
Dim cnn As New ADODB.Connection
Dim myPath As String
Dim myTable As String
myPath = ThisWorkbook.Path & "\数据库.mdb"
myTable = "数据表"
cnn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & myPath '连接数据库
SQL = "INSERT INTO " & myTable & " SELECT * FROM [Excel 8.0;Database=" _
& ThisWorkbook.FullName & ";].[" & ActiveSheet.Name & "$" & Range("A1").CurrentRegion.Address(0, 0) & "]"
cnn.Execute SQL
MsgBox "纪录添加成功。", vbInformation, "添加纪录"
cnn.Close
Set cnn = Nothing
End Sub

复制代码

zhaogang1960 · 发表于 2014-4-5 23:43

说明，不是在Access中编程，代码在Excel文件中
请测试附件

附件.rar (10.25 KB, 下载次数: 19)

zhaogang1960 · 发表于 2014-4-6 01:03

试验了一番，下面代码可以在Access中运行：

Sub 将EXCEL的数据一次性粘贴至ACCESS表内() 'ACCESSVBA中使用
' 引用Microsoft ActiveX Data Objects 2.8 Library
' 引用Microsoft ADO Ext. 2.8 for DDL and Security
Dim cnn As New ADODB.Connection
Dim myPath As String
Dim myTable As String
myPath = CurrentProject.Path & "\附件.xls"
myTable = "数据表"
cnn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & CurrentProject.FullName
SQL = "INSERT INTO " & myTable & " SELECT * FROM [Excel 8.0;Database=" & CurrentProject.Path & "\附件.xls;].[Sheet1$]"
cnn.Execute SQL
MsgBox "纪录添加成功。", vbInformation, "添加纪录"
cnn.Close
Set cnn = Nothing
End Sub

复制代码

zhaogang1960 · 发表于 2014-4-6 01:04

请看附件

数据库.rar (12.32 KB, 下载次数: 16)

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