Excel 通过 VBA 导出到 Access 导致不稳定

Question

我必须在 Excel 中创建 170 多个命名范围，并将其加载到 Access 表中。下面是我的代码。

Sub Load_To_ALLL_TSD()

Dim strDatabasePath As String
Dim oApp As Access.Application
Dim PathOfworkbook As String

PathToDB = ThisWorkbook.Path
strDatabasePath = PathToDB & "\RAROC.accdb"

Set oApp = CreateObject("Access.Application")
'Set db = Application.CurrentProject
oApp.Visible = True

oApp.OpenCurrentDatabase strDatabasePath

Set db = CurrentDb()
Set rs = db.OpenRecordset("ALLL_TSD", dbOpenTable)

    With oApp
            With rs
                .AddNew ' create a new record
                ' add values to each field in the record
                .Fields("TSD_Base_Rate_Received") = Range("TSD_Base_Rate_Received").Value
                .Fields("TSD_Base_Rate_Received_Input") = Range("TSD_Base_Rate_Received_Input").Value
                .Fields("TSD_Calculated_RAROC") = Range("TSD_Calculated_RAROC").Value
                .Fields("TSD_Capital_Factor") = Range("TSD_Capital_Factor").Value 

                ' etc, etc, lot more fields and named ranges here

                ' add more fields if necessary...
                .Update ' stores the new record
            End With
    End With
    
Set oApp = Nothing
MsgBox ("Done!  All Data saved to RAROC database!!")
 
End Sub

我遇到了一些奇怪的错误！如果我使用 F8 运行代码，它工作正常。如果我单击一个按钮来触发代码，有时它会起作用，有时它不起作用。我在几个不同的线路上出错了。

一旦它在这里抛出错误：

Set rs = db.OpenRecordset("ALLL_TSD", dbOpenTable)

错误读取'对象变量或未设置块'

一旦它说“Microsoft Access 已停止工作”，它就会在这一行抛出一个错误。

.Fields("TSD_Base_Rate_Received_Input") = Range("TSD_Base_Rate_Received_Input").Value

我还看到了一些其他奇怪的东西。

我对两者都有一个参考集：

Microsoft DAO 3.6 Object Library
Microsoft Access 14.0 Object Library

似乎我正在建立与 Access 的连接，然后我几乎立即失去了连接，不知何故。

最后，我没有表单或报告，并且数据库没有拆分。我现在只有一张桌子，我正试图写信给它。我可以尝试什么来解决这个问题？

Answer 1

这是一个不使用 Access 的基本示例。

需要参考 Microsoft ActiveX Data Objects 2.x 库

Sub Tester()

    Dim con As New ADODB.Connection, rs As New ADODB.Recordset

    con.Open "Provider=Microsoft.ACE.OLEDB.12.0;" _
             & "Data Source = " & ThisWorkbook.Path & "\RAROC.accdb"

    'get an empty recordset to add new records to
    rs.Open "select * from [ALLL_TSD] where false", con, _
             adOpenDynamic, adLockBatchOptimistic

    With rs
        .AddNew
        .Fields("TSD_Base_Rate_Received") = Range("TSD_Base_Rate_Received").Value
        .Fields("TSD_Base_Rate_Received_Input") = Range("TSD_Base_Rate_Received_Input").Value
        .Fields("TSD_Calculated_RAROC") = Range("TSD_Calculated_RAROC").Value
        .Fields("TSD_Capital_Factor") = Range("TSD_Capital_Factor").Value
        'etc...
        .UpdateBatch '<< EDIT
        .Close
    End With

    con.Close
End Sub