vb将excel导入数据库

没错，Access自带导入外部数据的功能，可以直接导入Excel,不过如果你实在想了解一下用VB怎么做的话，可以参考下面是我搞过的自用的读取Excel导入数据库的代码。必须建立了数据库，以及数据表和相应字段才行，要自动创建数据表我不会。总之，这下面是导入数据的过程，希望能对你有所帮助。

数据库DataBase.mdb ，表名data
Excel文件名test.xls ，目标工作表sheet1

Private Sub Command1_Click()
'工程->引用->Microsoft ActiveX Data Objects 2.X Library
On Error Resume Next
Dim i%, n%, l%
Dim Conn As New ADODB.Connection
Dim Rs As New ADODB.Recordset
Dim Cnt As Integer
Dim xConn As New ADODB.Connection
Dim xRs As New ADODB.Recordset
Dim xCnt As Integer

Conn.CursorLocation = adUseClient
Conn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Persist Security Info=False;Data Source=" & App.Path & "\DataBase.mdb"
If Rs.State <> adStateClosed Then Rs.Close
Rs.Open "select * from data", Conn, adOpenKeyset, adLockOptimistic

xConn.CursorLocation = adUseClient
'连接Excel的字符串，后面的“HDR=yes”需要注意，它的意思是把Excel表第一行作为字段名，第二行开始方是有效数据。HDR=no则反之，从第一行开始就看做有效数据。
xConn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\test.xls;Extended Properties='Excel 8.0;HDR=yes;IMEX=1'"
If xRs.State <> adStateClosed Then xRs.Close
'像打开数据库一样，使用SQL语言，打开名称为“sheet1”的工作表
xRs.Open "select * from [sheet1$]", xConn, adOpenStatic, adLockReadOnly
xCnt = xRs.RecordCount

If xCnt = 1 Then '因为HDR=yes，必有1行表头数据
MsgBox "请确认“test.xls”的“sheet1”工作簿内容不为空！否则无法导入任何数据！"
Exit Sub
End If
ProgressBar1.Max = xCnt
ProgressBar1.Min = 0
ProgressBar1.Value = 0
Label1.Caption = "0 / " & xCnt

For i = 0 To xCnt - 1
DoEvents
'下面的SQL插入语句自行更改，注意数据格式，如果是xRs("字段名1")的值是文本，记得在两边加单引号。
Conn.Execute "insert into data values(" & xRs("列名1") & "," & xRs("列名2") & "," & xRs("列名3") & ...... & ")"
xRs.MoveNext
Label1.Caption = i + 1 & " / " & xCnt
ProgressBar1.Value = i + 1
Next

Rs.Close : xRs.Close
Conn.Close : xConn.Close
Set Rs = Nothing : Set xRs = Nothing
Set Conn = Nothing : Set xConn = Nothing
End Sub

给你几段代码参考下，自己写出来应该没什么问题,程序自己写才有意思
一段是创建数据库和数据表的代码，令一段是读取数据库access记录到Excel表的，和你的要求正好相反，都是用ADO实现,自己改吧
Public Sub TEST1()
Dim myDb As DAO.Database
Dim myTbl As DAO.TableDef
Dim myData As String
Dim myTable As String
myData = ThisWorkbook.Path & "\学生成绩管理.mdb"
myTable = "期末成绩"
On Error Resume Next
Kill myData
On Error GoTo 0
Set myDb = CreateDatabase(myData, dbLangChineseSimplified)
Set myTbl = myDb.CreateTableDef(myTable)
With myTbl
.Fields.Append .CreateField("学号", dbText, 10)
.Fields.Append .CreateField("姓名", dbText, 6)
.Fields.Append .CreateField("性别", dbText, 1)
.Fields.Append .CreateField("班级", dbText, 10)
.Fields.Append .CreateField("数学", dbSingle)
.Fields.Append .CreateField("语文", dbSingle)
.Fields.Append .CreateField("物理", dbSingle)
.Fields.Append .CreateField("化学", dbSingle)
.Fields.Append .CreateField("英语", dbSingle)
.Fields.Append .CreateField("总分", dbSingle)
End With
myDb.TableDefs.Append myTbl
myDb.Close
Set myDb = Nothing
Set myTbl = Nothing
MsgBox "创建数据库成功！" & vbCrLf _
& "数据库文件名为：" & myData & vbCrLf _
& "数据表名称为：" & myTable & vbCrLf _
& "保存位置：" & ThisWorkbook.Path, _
vbOKOnly + vbInformation, "创建数据库"
End Sub

Public Sub TEST2()
Dim myData As String, myTable As String, SQL As String
Dim myDb As DAO.Database
Dim myRs As DAO.Recordset
Dim i As Integer
ActiveSheet.Cells.Clear
myData = ThisWorkbook.Path & "\职工管理.mdb"
myTable = "职工基本信息"
Set myDb = OpenDatabase(myData)
SQL = "select * from " & myTable & " order by 职工编号"
Set myRs = myDb.OpenRecordset(SQL)
MsgBox "数据库中的记录数为：" & myRs.RecordCount
If myRs.RecordCount > 0 Then
For i = 1 To myRs.Fields.Count
Cells(1, i) = myRs.Fields(i - 1).Name
Next i
With Range(Cells(1, 1), Cells(1, myRs.Fields.Count))
.Font.Bold = True
.HorizontalAlignment = xlCenter
End With
Range("A2").CopyFromRecordset myRs
ActiveSheet.Cells.Font.Size = 10
ActiveSheet.Columns.AutoFit
End If
myRs.Close
myDb.Close
Set myRs = Nothing
Set myDb = Nothing
End Sub

在数据库中将数字所在的列现由文本转换为数字就能用了。

用VB引用Excel、一行一行读、拼成SQL的Insert语句、
然后用ADO连接运行Insert语句。
通过这个方法可以100％正确插入。
你在Excel里设置成文本型是完全没用的。
把Excel设置为数据源一次性读入Recordset的方法非常有问题、
这种方法是读取前面N行判断该列的类型的、所以你在Excel里设置为文本或日期完全不会有任何作用。

在 ACCESS里可以直接导入
文件-获取外部数据-导入 选EXCEL文件