Export Excel Worksheet to Access Table (.accdb)

问题

I have a macro in Excel tied to a command button on one of my worksheets. When clicked, I'm trying to have the data from my worksheet "FeedSamples" be exported into an Access Database Table called "ImportedData".

Can anyone assist me? I've tried multiple examples from the net with no luck. This is what I have right now but keep receiving "Run-time error '3343': Unrecognized database format 'filePath\FeedSampleResults.accdb

Dim db As Database
Dim rs As Recordset
Dim r As Long
Set db = OpenDatabase("filePath\FeedSampleResults.accdb")
Set rs = db.OpenRecordset("ImportedData", dbOpenTable)
r = 2
Do While Len(Worksheets("FeedSamples").Range("A" & r).Formula) > 0
    With rs
        .AddNew
        .Fields("REPTNO") = Worksheets("FeedSamples").Range("B" & r).value
        .Update
    End With
    r = r + 1
Loop
rs.Close
Set rs = Nothing
db.Close
Set db = Nothing

Once I get this accomplished, I need to code to have the Access Table export the Data into a dBase file.

回答1:

Here's the code using ADO. You need to set the full path of your access database in Data Source.

Sub ExcelToAccessAdo()

    Dim cn As ADODB.Connection, rs As ADODB.Recordset, row As Long
    Set cn = New ADODB.Connection
    cn.Open "Provider=Microsoft.ACE.OLEDB.12.0; " & _
            "Data Source=filePath\FeedSampleResults.accdb;"

    ' open a recordset
    Set rs = New ADODB.Recordset
    rs.Open "ImportedData", cn, adOpenKeyset, adLockOptimistic, adCmdTable

    row = 3    ' the start row in the worksheet
    Do While Not IsEmpty(Worksheets("FeedSamples").Range("A" & row))

        With rs
            .AddNew    ' create a new record
            .Fields("REPTNO") = Worksheets("FeedSamples").Range("A" & row).Value
            .Update
        End With
        row = row + 1
    Loop

    rs.Close
    Set rs = Nothing
    cn.Close
    Set cn = Nothing

End Sub

来源：https://stackoverflow.com/questions/16949063/export-excel-worksheet-to-access-table-accdb