Sub FromExcelToAccess()
' exports data from the active worksheet to a table in an Access database
Dim db As String
Dim cnt As ADODB.Connection
Dim rs As ADODB.Recordset
Dim r As Long
Dim stTable As String
'in case you don't want the total Excel sheet to be exported to
'Access use an inputbox to state the number of the row that is the
'start point for [B]r[/B]. If you always start from the same row number just
'use that number instead of the Inputbox.
r = Inputbox("From what row do you want to start the insert?")
'Path to database [B]NOTE [/B]database and worksheet should be in the same folder
db = ThisWorkbook.Path & "\" & "yourdatabasename.mdb"
' open the database
Set cnt = New ADODB.Connection
Set rs = New ADODB.Recordset
stTable = ("Excel") 'Name on table in Access
cnt.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & "Data Source=" & db & ";"
rs.Open stTable, cnt, adOpenForwardOnly, adLockOptimistic, -1
' get all records in a table
Do While Len(Range("A" & r).Formula) > 0
' repeat until first empty cell in column A
With rs
.AddNew ' create a new record
' add values to each field in the record
.Fields("ID code") = Range("A" & r).Value
.Fields("ID Name") = Range("B" & r).Value
.Fields("Days") = Range("C" & r).Value
.Fields("Last test") = Range("D" & r).Value
.Update ' stores the new record in Access table
End With
r = r + 1 ' next row
Loop
rs.Close
Set rs = Nothing
cnt.Close
Set cnt = Nothing
End Sub