用VBA把EXCEL表导入ACCESS数据库中

   首先在指定的access数据库的建立一张表，表格的字段和需要导入EXCEL表的字段保持一致。

  方法一：在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

方法三：在excel编辑器中使用SQL语句，将EXCEL表导入到指定的数据库中

Sub 把Excel数据插入数据库中()
'*******************************************
'时间：2013-01-08
'作者：Allen
'功能：把当前工作表的数据增加到在程序文件同一目录下进销存表数据库中
'注意：要在工具/引用中引用microsoft activex date objects x.x
'      其中x.x为版本号，可能会因为你安装的office的版本不同而不同，本例引用了2.5版
'*******************************************
Dim conn As ADODB.Connection
Dim WN As String
Dim TableName As String
Dim sSql As String
Dim tStr As String
'数据库名，请自行修改，路径与当前工作簿在同一目录
WN = "Staff.mdb"
'数据库的表名与当前工作表名一致
TableName = ActiveSheet.Name


Set conn = New ADODB.Connection
conn.ConnectionString = "Provider=Microsoft.Jet.Oledb.4.0;" & _
                        "Extended Properties=Excel 8.0;" & _
                        "Data Source= E:\ExcelTest\Employee.xls ;;Extended Properties='Excel 8.0;HDR=YES;IMEX=1' "
conn.Open
If conn.State = adStateOpen Then
    sSql = "Insert Into [;DataBase=" & ActiveWorkbook.Path & "\" & WN & "]." & myWbName & " Select * From [" & ActiveSheet.Name & "$]"
      Cnn.Execute sSql
    MsgBox "成功把数据插入到“" & TableName & "”中！", , "http://Allen.com"
    conn.Close
End If
Set conn = Nothing
End Sub