VBA execl将数据导入数据库

Sub 把Excel数据插入数据库中()

'*******************************************

'时间：2010-06-28

'作者：bengdeng

'功能：把当前工作表的数据增加到在程序文件同一目录下进销存表数据库中

'注意：要在工具/引用中引用microsoft activex date objects x.x

' 其中x.x为版本号，可能会因为你安装的office的版本不同而不同，本例引用了2.5版

'发布：http://www.excelba.com

'*******************************************

Dim conn As ADODB.Connection

Dim WN As String

Dim TableName As String

Dim sSql As String

Dim tStr As String

'数据库名，请自行修改，路径与当前工作簿在同一目录

WN = "进销存表.mdb"

'数据库的表名与当前工作表名一致

TableName = ActiveSheet.Name

Set conn = New ADODB.Connection

conn.ConnectionString = "Provider=Microsoft.Jet.Oledb.4.0" &_

"Extended Properties=Excel 8.0" &_

"Data Source=" &ThisWorkbook.Path &"\" &ActiveWorkbook.Name

conn.Open

If conn.State = adStateOpen Then

sSql = "Insert Into [DataBase=" &ActiveWorkbook.Path &"\" &WN &"]." &TableName &" Select * From [" &ActiveSheet.Name &"$]"

conn.Execute sSql

MsgBox "成功把数据插入到“" &TableName &"”中！", , "http://excelba.com"

conn.Close

End If

Set conn = Nothing

End Sub

方法一：在eccel VBA编辑器编写代码，使用FOR循环导入：

Sub 利用Excel的VBA将数据写入Access()

'定义ADODB 连接Access数据库

Dim Cnn As New ADODB.Connection

Dim Rs As New ADODB.Recordset

Dim strCon As String

Dim strFileName As String '数据库文件名

strFileName = InputBox("请输入文件路径及文件名：", "Excel传递数据至Access", "E:\ExcelTest\Staff.mdb")

'连接字符串，我这里是Access2010,所提供者参数为：Provider=Microsoft.ACE.OLEDB.12.0

'如果此参数不能使用，根据自己的电脑修改这个字符串

'至于连接至的数据库名，根据自己的电脑修改，或用一个对话框或其他方式将此值传递进程序

strCon = "provider=Microsoft.jet.OLEDB.4.0" _

&"Data Source=" &strFileName &""

Cnn.Open strCon

Rs.ActiveConnection = Cnn

Rs.LockType = adLockOptimistic

Rs.Open "Employee" '假设表为Employee

'定义Excel表中的数据区域以写入Access

Dim Sht As Worksheet

Dim Rn As Long

Dim Cn As Long

Set Sht = ThisWorkbook.Sheets("Sheet1")

'假设将 Sheet1 表的 2-6行的1、2、3列写入Access表

For Rn = 2 To 6

Rs.AddNew

Rs!num = Sht.Cells(Rn, 1) ’num,name,department是数据库中指定表的字段

Rs!Name = Sht.Cells(Rn, 2)

Rs!department = Sht.Cells(Rn, 3)

Rs.Update

Next Rn

MsgBox "完成!"

Rs.Close

Cnn.Close

Set Rs = Nothing

Set Cnn = Nothing

Set Sht = Nothing

End Sub

方法二：在access VBA编辑器中编写代码

Sub ExcelToAccess()

DoCmd.TransferSpreadsheet acImport, , "Staff", "E:\ExcelTest\Employee.xls", True, "Sheet1!"‘DoCmd.TransferSpreadsheet是access编辑器中函数

End Sub

---