导出Excel工作表来访问表（.ACCDB）

Question

我在Excel中的宏绑定到一个命令按钮在我的工作表中的一个。点击时，我试图将工作表“FeedSamples”中的数据导出到名为“ImportedData”的Access数据库表中。

谁能帮助我？我从网上尝试了多个例子，但没有运气。这是我现在却不断收到“运行时错误‘3343’：无法识别的数据库格式“文件路径\ 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 

一旦我得到这个成就，我需要的代码有访问表导出数据到一个dBASE文件。

Answer 1

下面是使用ADO。你需要设置数据源Access数据库的完整路径的代码。

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