vba 将 Excel 工作表导出到 Access 表 (.accdb)
声明：本页面是StackOverFlow热门问题的中英对照翻译，遵循CC BY-SA 4.0协议，如果您需要使用它，必须同样遵循CC BY-SA许可，注明原文地址和作者信息，同时你必须将它归于原作者（不是我）：StackOverFlow
原文地址: http://stackoverflow.com/questions/16949063/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me):
StackOverFlow
Export Excel Worksheet to Access Table (.accdb)
提问by Analytic Lunatic
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".
我在 Excel 中有一个宏与我的一张工作表上的命令按钮相关联。单击时，我试图将工作表“FeedSamples”中的数据导出到名为“ImportedData”的 Access 数据库表中。
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
任何人都可以帮助我吗？我已经从网上尝试了多个例子，但都没有运气。这就是我现在所拥有的，但一直收到“运行时错误‘3343’：无法识别的数据库格式‘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.
完成此操作后，我需要编写代码以使访问表将数据导出到 dBase 文件中。
回答by Santosh
Here's the code using ADO. You need to set the full path of your access database in Data Source.
这是使用 ADO 的代码。您需要在数据源中设置访问数据库的完整路径。
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
