Excel将命名范围导出到Access。使用VBA并遇到不稳定问题!! [英] Excel Exporting Named Ranges to Access. Using VBA and Having Instability Issues!!

问题描述

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

I have to create over 170 named ranges in Excel which I am trying to load into an Access table. Below is my code.

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 = oApp.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运行代码，它可以正常工作。如果我单击一个按钮来激活代码，有时它会工作，有时它不起作用。我在几个不同的行上犯了错误。

I'm getting some weird errors! If I run the code using F8, it works fine. If I click a button to fire the code, sometimes it works and sometimes it doesn't work. I has errored out on several different lines.

一旦它在这里抛出错误：

Once it threw an error here:

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

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

Error reads 'object variable or with block not set'

一旦说出' Microsoft Access已停止工作'并且它在此行上引发了错误。

Once it said 'Microsoft Access has stopped working' and it threw an error on this line.

.Fields（" TSD_Base_Rate_Received_Input"）= Range（" TSD_Base_Rate_Received_Input"）。Value

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

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

I've seen some other weird things too.

我的引用设置为：

Microsoft DAO 3.6 Object Library
Microsoft Access 14.0 Object Library

我好像在建立一个连接到Access，然后几乎立即我失去了连接，不知何故。

It almost seems like I'm establishing a connection to Access and then almost immediately I lost the connection, somehow.

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

Finally, I have no Forms or Reports, and the DB is not split. I have just one single table in there now, which I am trying to write to.

有人可以帮助我吗？

谢谢！

推荐答案

设置对Microsoft Office 14.0 Access数据库引擎的引用，而不是DAO 3.6对象库（用于.mdb数据库）对象库（用于.accdb和.mdb）。

Instead of the DAO 3.6 Object Library (which is for .mdb databases), set a reference to the Microsoft Office 14.0 Access database engine Object Library (which is for .accdb AND .mdb).

我认为不需要打开Access应用程序;你可以简单地打开一个DAO数据库和记录集并使用它。

I see no need to open the Access application; you can simply open a DAO database and recordset and use that.

Sub Load_To_ALLL_TSD()
    Dim strDatabasePath As String
    Dim PathToDB As String
    Dim db As DAO.Database
    Dim rs As DAO.Recordset

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

    Set db = DAO.DBEngine.OpenDatabase(strDatabasePath)
    Set rs = db.OpenRecordset("ALLL_TSD", dbOpenDynaset)

    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
        .Update ' stores the new record
    End With

    rs.Close
    db.Close

    MsgBox "Done!  All Data saved to RAROC database!!"
End Sub

如果要导出所有命名范围，并且如果每个字段都有一个完全相同的字段，则可以遍历名称：

If you want to export ALL named ranges and if there is a field with exactly the same name for each, you could loop through the names:

Sub Load_To_ALLL_TSD()
    Dim strDatabasePath As String
    Dim PathToDB As String
    Dim db As DAO.Database
    Dim rs As DAO.Recordset
    Dim nm As Name

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

    Set db = DAO.DBEngine.OpenDatabase(strDatabasePath)
    Set rs = db.OpenRecordset("ALLL_TSD", dbOpenDynaset)

    With rs
        .AddNew ' create a new record
        ' add values to each field in the record
        For Each nm In ThisWorkbook.Names
            .Fields(nm.Name) = nm.Value
        Next nm
        .Update ' stores the new record
    End With

    rs.Close
    db.Close

    MsgBox "Done!  All Data saved to RAROC database!!"
End Sub

顺便说一下，我会以不同的方式构造表：我会使用RangeName字段和RangeValue字段，并添加一个每个已定义名称的新记录。将其名称存储在RangeName字段中，并将其值存储在RangeValue字段中。

By the way, I would structure the table differently: I would use a RangeName field and a RangeValue field, and add a new record for each defined name. Store its name in the RangeName field and its value in the RangeValue field.

这篇关于Excel将命名范围导出到Access。使用VBA并遇到不稳定问题!!的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！