为什么 Excel 2016 VBA 代码在使用几次后会崩溃？

Question

我们有一个 Excel 报价工具，它使用 VBA 代码将输入的产品代码与 Access 数据库进行比较，基本数据库没什么特别的，然后用我们的 CRM 系统所需的详细信息更新另一张表。这是一个临时解决方案，直到有更永久的解决方案可用。问题在于我们可以捕获 5 个报价，生成 CRM 工作表，一切都很好，但是在第 6 个报价时，当您生成 CRM 工作表时，会出现以下 VBA 错误。

系统错误 &H8000FFF (-2147418113)

我在黑暗中拍摄我尝试过的修复，增加缓冲区大小，清除剪贴板是我尝试过的主要修复。完全删除缓冲区几乎会立即导致错误。

我使用 Step Into 调试过程发现崩溃将发生在代码的 cn.Open 部分，因此它会尝试打开与 Access 的连接。

Function CRM_Update(PROD As String)
Application.ScreenUpdating = False

    If PROD = "" Then
        emptyline = emptyline + 1
        Exit Function
    Else
            emptyline = 0
    End If
    Set cn = New ADODB.Connection
    cn.ConnectionString = "DSN=MS Access Database;DBQ=C:\database\CRMSA.accdb;DriverId=25;FIL=MS Access;MaxBufferSize=4096;PageTimeout=5;"
    cn.Open
    Set rs = New ADODB.Recordset**
    rs.Open "select * from ARTGROUP WHERE  ART = '" & PROD & "';", cn, adOpenStatic
    If rs.RecordCount = 0 Then
        MsgBox (PROD & "  " & " not found in article group")
        Exit Function
    End If

这似乎与内存使用有关，因为如果您打开的项目很少，但只要打开很多项目，您就可以进一步进入生成过程：Chrome、Outlook 和其他应用程序，您可能会获得 5 个生成尝试。在只有 4GB RAM 的虚拟机上，我能够执行此过程超过 40 次而没有发生一次崩溃。在我的具有 16GB RAM 的工作笔记本电脑上，只有这个打开，我才能在该错误出现之前生成大约 16 次。另一个有趣的信息是显示事件日志的内容：

The system has called a custom component and that component has failed
and generated an exception. This indicates a problem with the custom
component. Notify the developer of this component that a failure has
occurred and provide them with the information below. Component Prog
ID: SC.Pool 455 1 Method Name: IDispenserDriver::CreateResource
Process Name: EXCEL.EXE Exception: c0000005 Address: 0X58101018

我已删除所有自定义加载项，但仍会出现此崩溃。我在运行的工作表中只有以下 MS 参考：

VB for Applications
MS Excel 16.0 Object Library
OLE Automation
MS Office 16.0 Object Library
MS Access 16.0 Object Library
Microsoft ActiveX Data Objects 2.8 Library

发生了什么事？我也尝试过重建数据库，压缩和修复和反编译，但没有效果。我已将 AV 程序中的数据库列入白名单，没有任何变化。

编辑

好的，为了便于阅读，我将尝试将此编辑分成 3 个部分。模块 1 是我认为打开 Access 数据库的第一个 VB 脚本。模块 2 是 VB 脚本，表示工作表 A 中的单元格 A 转到工作表 B 中的单元格 A，它也打开了与 Access 数据库的连接，但我没有包含移动部分的公式。还有第三个模块将 Excel 表中的数据与 Access 数据库进行比较，然后为其分配产品代码，我认为这不是问题，但如果其他两个没有透露任何内容，我会发布。

---

模块 1：

Public Function CRM_shortDescr(PROD As String)
Application.ScreenUpdating = False
    Set cn = New ADODB.Connection
    cn.ConnectionString = "DSN=MS Access Database;DBQ=C:\database\CRMSA.accdb;DriverId=25;FIL=MS Access;MaxBufferSize=4096;PageTimeout=5;"
    '   The database name was set incorrectly here. Changed to correct name.
    cn.Open
    Set rs = New ADODB.Recordset
    rs.Open "select * from ARTGROUP WHERE  ART = '" & PROD & "';", cn, adOpenStatic
    If rs.RecordCount = 0 Then
        MsgBox (PROD & "  " & " not found in article group")
        Exit Function
    End If
    PRGR = rs!crm
    rs.Close
    rs.Open "select * from PRGR WHERE  PRGR = '" & Left(PRGR, 2) & "';", cn, adOpenStatic
    If rs.RecordCount = 0 Then
        MsgBox (PRGR & "  " & " not found in article group")
        Exit Function
    End If
    CRM_shortDescr = rs!Descr
    rs.Close
End Function

---

实际上模块 2 是上面请求帮助开始时的那个，缺少的行是：

    italyrow = 19 + emptyline
        linenumber = ActiveCell.Row
        linenumbercrm = linenumber - italyrow
    <Formual starts to move from Sheet A to Sheet B but looks like the following
`Worksheets("CRM").Cells(linenumbercrm, 1).Value = Worksheets("Local Quotation").Range("COUNTRY")>
    rs.Close
    End Function

Answer 1

问题似乎已解决，与代码 <_ href="https://support.microsoft.com/en-za/help/4484218/january-7-2020-update-for-office-2016-kb4484218" rel="nofollow" target="_blank">KB4484218 是以某种方式破坏一切的罪魁祸首。