时间戳

首页 > 解决方案 > VBA - 1004：应用程序定义或对象定义的错误仅在导出到包含大量数据的 Excel 时出现

excel - VBA - 1004：应用程序定义或对象定义的错误仅在导出到包含大量数据的 Excel 时出现

问题描述

我最近从我的 Access VBA 代码中得到了这种奇怪的行为，我无法弄清楚为什么会发生这个错误。

我正在尝试将数据从数据库导出到 Excel 文件。我操作了一些单元格和范围（主要是插入信息，但有时合并单元格、插入新行等），但是，我不断收到此错误：

1004 应用程序定义或对象定义错误

在这条线上：

xlApp.Cells(currentRowPointer, 8) = rs_vendorNPO("Vendor_Name")

现在，这条线被调用了几十次，因为我正在循环多个记录集，而这条线在循环内。当currentRowPointer = 91. currentRowPointer因此，要查看91时的变量值，我在上面添加了以下内容：

If currentRowPointer = 91 Then
    Stop
End If
xlApp.Cells(currentRowPointer, 8) = rs_vendorNPO("Vendor_Name")

Stop基本上会添加一个动态断点。因此，它在 时停止currentRowPointer = 91，并且所有值似乎都正常。我再次点击运行。这一次，它没有失败91，它失败了114。每次我这样做时，它都会在 114 上失败。所以我将其添加到 if 语句中：

If currentRowPointer = 91 Or currentRowPointer = 114 Then
    Stop
End If
xlApp.Cells(currentRowPointer, 8) = rs_vendorNPO("Vendor_Name")

果然，它运行得很好。为了查看它是否与该迭代有任何关系，我将 if 语句更改为：

If currentRowPointer = 87 Or currentRowPointer = 114 Then
    Stop
End If

只是看看会发生什么。在第一个断点之后87，它没有失败114，它失败了111。下次我运行它时，它失败了112。

这清楚地表明它与该迭代无关，并且是 Access 内部的东西。

作为最后一项测试，我在该行上放置了一个断点（并在Stop调用中删除了 if 语句）。我遍历了整个流程，没有错误。

问题：

什么可能导致此问题？一遍又一遍地调用相同的行，但只是在一段时间后它似乎失败了。同样，当我导出到 excel 的数据很小并且运行时间很快时，也不会出现此问题。

这让我相信这是某种内存问题？如果是这样，我该怎么做才能调试/确保它不会发生？

这是我打开文件的地方：

Public xlApp As Excel.Application
Public wb As Excel.Workbook

Private Function openSpendReport(templatePath As String, filePath As String, JobID As String)

On Error GoTo ErrorHandler

    Set xlApp = CreateObject("Excel.Application")

    'make a copy, file must be closed
    FileCopy templatePath, filePath
    
    xlApp.Visible = True
    Set wb = xlApp.Workbooks.Open(filePath)
    xlApp.Sheets("Summary Template").Select

Exit Function

ErrorHandler:
    DoCmd.Hourglass False
    If Err.Number = 70 Then
        MsgBox "Close the file before running the report"
    Else
        MsgBox (Err.Number & ": " & Err.Description)
    End If

    End

End Function

这是发生错误的函数（我添加了一行 = 符号来突出显示它）：

Private Sub getVendorNonPO(JobID As Variant)

    On Error GoTo ErrorHandler

    Dim rs_vendorNPO As DAO.Recordset

    sql = "<sql_statement>"
    
    Set rs_vendorNPO = CurrentDb.OpenRecordset(sql)
    If Not rs_vendorNPO.EOF Then
        Do Until rs_vendorNPO.EOF
            'add a row if necessary
            If (poRowsCount >= 8) Then
                If (cellsMerged = 0) Then
                    xlApp.Range("A" & poLineRow & ":" & "C" & currentRowPointer + 1).UnMerge 'unmerge cells
                    xlApp.Range("D" & poLineRow & ":" & "F" & currentRowPointer + 1).UnMerge
                    xlApp.Range("G" & poLineRow & ":" & "G" & currentRowPointer + 1).UnMerge
                    cellsMerged = 1
                End If

                Dim rng As Range
                Set rng = xlApp.Range("A" & currentRowPointer)

                xlApp.Rows(rng.Row).Copy
                xlApp.Rows(rng.Row).Insert Shift:=xlDown

                Debug.Print ("copying cells and shifting copied cells down")
                
                ' keep track of the added rows
                poRowsAdded = poRowsAdded + 1
            End If
            
            Debug.Print ("in with 1")
            Debug.Print ("current row pointer: " & currentRowPointer)
            Debug.Print ("vendor name" & rs_vendorNPO("vendor_name"))

            ' ==========================================================================================================
            ' Issue is here
            ' ==========================================================================================================
            xlApp.Worksheets("Summary Template").Cells(currentRowPointer, 8) = rs_vendorNPO("Vendor_Name")
            Debug.Print ("in with 2")
            xlApp.Cells(currentRowPointer, 8) = rs_vendorNPO("Vendor_Name")
            xlApp.Cells(currentRowPointer, 12) = rs_vendorNPO("InvoiceNum")
            xlApp.Cells(currentRowPointer, 13) = rs_vendorNPO("InvoiceDate")
            xlApp.Cells(currentRowPointer, 14) = rs_vendorNPO("LineAmountConverted")
            xlApp.Cells(currentRowPointer, 10) = rs_vendorNPO("InvoiceDate")
            xlApp.Cells(currentRowPointer, 11) = rs_vendorNPO("LineAmountConverted")
            
            If Not IsNull(rs_vendorNPO("ProofOfPayment")) Then
                xlApp.Cells(currentRowPointer, "O") = rs_vendorNPO("ProofOfPayment")
            End If
            
            currentRowPointer = currentRowPointer + 1
            poRowsCount = poRowsCount + 1
            rs_vendorNPO.MoveNext
        Loop
        rs_vendorNPO.Close
        Set rs_vendorNPO = Nothing
    End If

Exit Sub

ErrorHandler:

    DoCmd.Hourglass False
    MsgBox (Err.Number & ": " & Err.Description & ". " & Err.Source)
    wb.Save
    xlApp.Quit
    Set xlApp = Nothing
    End

End Sub

以下是一些调试语句的输出（已删除敏感信息）：

...
in with 1
current row pointer: 90
vendor name_____
in with 2
copying cells and shifting copied cells down
in with 1
current row pointer: 91
vendor name_____

调试语句从 83 开始。它们都发生在同一个循环中，所以我只显示最后一对。您可以看到它获取供应商名称并在之后立即失败。

标签： excelvbams-access

解决方案

从外部（例如 Access）处理 Excel 对象时，最好始终严格遵循对象的层次结构，即：

Application -> Workbook -> Worksheet -> .Cells, .Range, ...

我不确定这会解决您的问题，但恕我直言，机会很大。
所以你应该这样做：

Dim sh As Excel.Worksheet   ' or Public, if you really need

Set wb = xlApp.Workbooks.Open(filePath)
Set sh = wb.Worksheets("Summary Template")
' The following is not necessary for the code to work, only if you want to watch what happens
sh.Select

然后将您必须xlApp的所有内容更改为正确的参考：

xlApp.Range    =>    sh.Range
xlApp.Rows     =>    sh.Rows
xlApp.Cells    =>    sh.Cells
xlApp.Worksheets("Summary Template").Cells    =>    sh.Cells

推荐阅读