高手来！关于将Excel中数据用VBA代码读到Access中

如果字段相同可以直接用Access的导入功能导入。
如果没有安装Access可以用VBA的ADODB

把以下代码直接放在模块里
改一下连接字符串的路径
就可以直接用Sql语句往Access里写数据了。
从Excel的单元格中取数据然后Insert到Access中。
需要了解一下Sql语句

Option Explicit

Private Iscon As Boolean
Private con_Num As Integer
Private con As ADODB.Connection
Private rs As ADODB.Recordset
Private m_conStr As String

Private Sub Connect()
Dim constr As String
If Iscon = True Then
Exit Sub
End If
Set con = New ADODB.Connection
'constr = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\db.mdb;Persist Security Info=False"

Debug.Print constr
con.ConnectionString = constr
Debug.Print con.ConnectionString

con.Open
If con.State <> adStateOpen Then
MsgBox "データベース接続失败"
End If
Iscon = True
End Sub

Private Sub Discon()
Dim rc As Long
If Iscon = False Then
Exit Sub
End If
con.Close
Iscon = False
End Sub

Public Sub db_con()
con_Num = con_Num + 1
Connect
End Sub

Public Sub db_Discon()
If con_Num >= 10 Then
con_Num = 0
Discon
End If
End Sub

Public Sub dbapi_Discon()
con_Num = 0
Discon
End Sub

Public Sub SQLext(ByVal tmpSQL As String)
Dim cmd As New ADODB.Command
db_con
Set cmd.ActiveConnection = con
cmd.CommandText = tmpSQL
cmd.Execute
Set cmd = Nothing
db_Discon
End Sub

Public Function ReEXt(ByVal tmpSQL As String) As ADODB.Recordset
Dim rst As New ADODB.Recordset
db_con
Set rst.ActiveConnection = con
rst.CursorType = adOpenDynamic
rst.LockType = adLockOptimistic
rst.CursorLocation = adUseClient
rst.Open tmpSQL
Set ReEXt = rst
End Function
Public Sub waittime(delay As Single)
Dim starttime As Single
starttime = Timer
Do Until (Timer - starttime) > delay
Loop
End Sub

Private Sub Button3_Released()
Set objExcel = CreateObject("Excel.Application")
With objExcel
.Application.Visible = True
.Application.Workbooks.Add
.Worksheets("Sheet1").Activate
.Columns(1).ColumnWidth = 23
.Columns(2).ColumnWidth = 15
.Columns(3).ColumnWidth = 15
.Columns(4).ColumnWidth = 15
.Columns(5).ColumnWidth = 15
.Columns(6).ColumnWidth = 15
.Columns(7).ColumnWidth = 15
.Columns(18).ColumnWidth = 15
.cells(1, 2).Value = "1o?éè?¨??á?"
.cells(1, 3).Value = "1o?2ú?·??á?"
.cells(1, 4).Value = "2o?éè?¨??á?"
.cells(1, 5).Value = "2o?2ú?·??á?"
.cells(1, 6).Value = "3o?éè?¨??á?"
.cells(1, 7).Value = "3o?2ú?·??á?"
.cells(1, 8).Value = "??·?"
End With
Set cn1 = CreateObject("adodb.connection")
cn1.Open "driver={microsoft access driver (*.mdb)};DBQ=D:\datalog\weight.mdb"
Set rs1 = CreateObject("adodb.recordset")
SQL1 = "select * from FloatTable where marker='s'"
rs1.Open SQL1, cn1
rs1.MoveFirst
i = 2
j = 0
n = 6
Do While Not rs1.EOF
objExcel.Sheets(1).cells(i, 1) = rs1("DateAndTime")
objExcel.Sheets(1).cells(i, 1).numberformatLocal = "yyyy-m-d h:mm:ss"
Do While j < n
objExcel.Sheets(1).cells(i, j + 2) = rs1("Val")
rs1.MoveNext
j = j + 1
Loop
i = i + 1
j = j - n
Loop
rs1.close
Set cn2 = CreateObject("adodb.connection")
cn2.Open "driver={microsoft access driver (*.mdb)};DBQ=D:\datalog\weight.mdb"
Set rs2 = CreateObject("adodb.recordset")
sql2 = "select * from stringTable where marker='s'"
rs2.Open sql2, cn2
rs2.MoveFirst
i = 2
Do While Not rs2.EOF
objExcel.Sheets(1).cells(i, j + 8) = rs2("Val")
rs2.MoveNext
i = i + 1
Loop
rs2.close
End SubPrivate Sub Button3_Released()
Set objExcel = CreateObject("Excel.Application")
With objExcel
.Application.Visible = True
.Application.Workbooks.Add
.Worksheets("Sheet1").Activate
.Columns(1).ColumnWidth = 23
.Columns(2).ColumnWidth = 15
.Columns(3).ColumnWidth = 15
.Columns(4).ColumnWidth = 15
.Columns(5).ColumnWidth = 15
.Columns(6).ColumnWidth = 15
.Columns(7).ColumnWidth = 15
.Columns(18).ColumnWidth = 15
.cells(1, 2).Value = "1o?éè?¨??á?"
.cells(1, 3).Value = "1o?2ú?·??á?"
.cells(1, 4).Value = "2o?éè?¨??á?"
.cells(1, 5).Value = "2o?2ú?·??á?"
.cells(1, 6).Value = "3o?éè?¨??á?"
.cells(1, 7).Value = "3o?2ú?·??á?"
.cells(1, 8).Value = "??·?"
End With
Set cn1 = CreateObject("adodb.connection")
cn1.Open "driver={microsoft access driver (*.mdb)};DBQ=D:\datalog\weight.mdb"
Set rs1 = CreateObject("adodb.recordset")
SQL1 = "select * from FloatTable where marker='s'"
rs1.Open SQL1, cn1
rs1.MoveFirst
i = 2
j = 0
n = 6
Do While Not rs1.EOF
objExcel.Sheets(1).cells(i, 1) = rs1("DateAndTime")
objExcel.Sheets(1).cells(i, 1).numberformatLocal = "yyyy-m-d h:mm:ss"
Do While j < n
objExcel.Sheets(1).cells(i, j + 2) = rs1("Val")
rs1.MoveNext
j = j + 1
Loop
i = i + 1
j = j - n
Loop
rs1.close