importing from access using VBA

[rogerm]

I have been using the following code to export data from excel into an access database.


Sub export()
Dim cn As ADODB.Connection, rs As ADODB.Recordset, r As Long
var1 = "export to database complete"
' connect to the Access database
Set cn = New ADODB.Connection
cn.Open "Provider=Microsoft.Jet.OLEDB.4.0; Data Source=\\SERVER19\mainfolder\subfolder\data.mdb;"
' open a recordset
Set rs = New ADODB.Recordset
rs.Open "tablename", cn, adOpenKeyset, adLockOptimistic, adCmdTable ' all records in a table
r = 4 ' the start row in the worksheet
Do While Len(Range("B" & r).Formula) > 0 ' repeat until first empty cell in column A
'If Range("Q" & r).Value = "New Item" Then
With rs
.AddNew ' create a new record
.Fields("F1") = Range("B" & r).Value
.Fields("F2") = Range("C" & r).Value
.Fields("F3") = Range("D" & r).Value
.Fields("F4") = Range("E" & r).Value
.Fields("F5") = Range("F" & r).Value
.Fields("F6") = Range("G" & r).Value
.Fields("F7") = Range("H" & r).Value
.Fields("F8") = Range("I" & r).Value
.Fields("F9") = Range("J" & r).Value
.Fields("F11") = Date
.Fields("Sheet_Date") = Range("F36").Value
.Fields("Comp_By") = Range("C38").Value

.Update ' stores the new record

End With
r = r + 1 ' next row
Loop
rs.Close
Set rs = Nothing
cn.Close
Set cn = Nothing
MsgBox var1
End Sub

Does anyone know a way to do the same thing but using a button on access to import the data.

Most of the solutions I have seen only import a whole spreadsheet or a named range which often imports blank rows if there is no data in these rows.

Any help would be greatly appreciated.