Sub fromExcelToAccess()
    Dim dbe As Object 'DAO.DBEngine
    Dim db  As Object 'DAO.Database
    Dim rst As Object 'DAO.Recordset
    Dim i As Long
    Set dbe = CreateObject("DAO.DBEngine.120")
    Set db = dbe.OpenDatabase("D:\MyDoc\Access\tmp.mdb")
    Set rst = db.TableDefs("Таблица1").OpenRecordset
            For i = 1 To Range("A" & Cells.Rows.Count).End(xlUp).Row - 1
            rst.AddNew
            rst("Поле1") = Range("a" & 1 + i).Value 'или rst(0)...rst(N)
            rst("Поле2") = Range("b" & 1 + i).Value
            rst("Поле3") = Range("c" & 1 + i).Value
           'rst("поле4") = Date()
        rst.Update
    Next
  End Sub

s = "INSERT INTO таблица SELECT * FROM [Excel 8.0;HDR=yes;DATABASE=D:\help\forum\excelToAccess.xls].[Лист1$A1:D100];"
CurrentDb.Execute s

Private Sub  cmb_Click()
Dim dlgOpen, p, s
Set dlgOpen = Application.FileDialog(1)
'With dlgOpen   'в блоке задаются параметры и вид FileDialog 
'    .AllowMultiSelect = False ' "умолчательное" свойство
'   .......
'End With
  If dlgOpen.Show = -1 Then
       p = dlgOpen.SelectedItems.Item(1)
  End If
s = "INSERT INTO таблица1 SELECT * FROM [Excel 8.0;HDR=yes;DATABASE=" & p & "].[лист1$A1:D100];"
CurrentDb.Execute s
End Sub