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)

错误读取＆＃39;对象变量或未设置块＆＃39;

一旦它说“Microsoft Access已停止工作＆＃39;它在这一行上犯了一个错误。

.Fields（＆＃34; TSD_Base_Rate_Received_Input＆＃34;）=范围（＆＃34; TSD_Base_Rate_Received_Input＆＃34;）。值

我也见过其他一些奇怪的东西。

我有两个参考设置：

Microsoft DAO 3.6 Object Library
Microsoft Access 14.0 Object Library

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

最后，我没有表格或报告，并且数据库没有拆分。我现在只有一张桌子，我想写信给你。

有人可以帮助我吗？

谢谢！

Answer 1

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

需要引用 Microsoft ActiveX Data Objects 2.x Library

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

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

1 个答案: