循环“批量导出”崩溃 - 处理器或代码错误？

Posted 2023-03-17

【中文标题】循环“批量导出”崩溃 - 处理器或代码错误？

【英文标题】：Looping "Batch Export" Crashes - Processor or Code Error?

【发布时间】：2018-11-09 22:02:13

【问题描述】：

为什么 Excel 不能循环遍历大型数据集？！

我有 2 种不同的文档形式，需要成百上千的导出为 PDF。我从互联网上提取了批量导出脚本并对其进行了修改以供我使用，因此它可以根据“批量 PDF 打印机”工作表上选中的复选框来处理这些表单中的任何一个。

一切运行良好 - 对于循环访问的前 10-15 个工作簿，然后它崩溃了。每个 Excel 文档都会冻结（无响应），并且当前由宏访问的页面部分打开，没有可见的数据或单元格。此时“发布”消息框也可能会冻结。一旦它报告缺少内存错误-但我无法重复此操作。 Excel不应该删除未使用的缓存以免内存超载吗？如果它有一段时间运行不好，我会怀疑它是一个循环。我听说没有办法在“缓存转储”或类似性质的东西中编写脚本。是代码不好，还是我对处理器的要求太高了？

Sub Convert2PDF()
'Update the checkbox linked formulas on the GUI workbook
Sheet1.Range("A2").Formula = Sheet1.Range("A2").Formula
Sheet1.Range("B2").Formula = Sheet1.Range("B2").Formula
Sheet1.Range("C2").Formula = Sheet1.Range("C2").Formula

Dim strFolder As String
Dim strXLFile As String
Dim strPDFFile As String
Dim wbk As Workbook
Dim lngPos As Long
' set folder
strFolder = ThisWorkbook.Path & "\putfileshere" & "\"
Application.ScreenUpdating = False
' Get first filename
strXLFile = Dir(strFolder & "*.xls*")
' Loop through Excel workbooks in folder
Do While strXLFile <> ""
    ' Open workbook
    Set wbk = Workbooks.Open(Filename:=strFolder & strXLFile)
    ' Assemble the PDF filename
    lngPos = InStrRev(strXLFile, ".")
    strPDFFile = Left(strXLFile, lngPos) & "pdf"
    ' Export to PDF
    'Do the next 8 lines crash the Macro because they recalculate for every sheet? Page1, Page2, Page3 value are the same for all workbooks processed in a batch
            Dim Page1 As String
            Dim Page2 As String
            Dim Page3 As String
            Dim Page4 As String
                Page1 = ThisWorkbook.Sheets("Batch PDF Printer").Range("A2")
                Page2 = ThisWorkbook.Sheets("Batch PDF Printer").Range("B2")
                Page3 = ThisWorkbook.Sheets("Batch PDF Printer").Range("C2")

            If ThisWorkbook.Sheets("Batch PDF Printer").Range("C2") = "" Then 
                wbk.Sheets(Array(Page1, Page2)).Select
                ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
                    ThisWorkbook.Path & "\pdfsgohere" & "\" & wbk.Name, _
                    Quality:=xlQualityStandard, IncludeDocProperties:=False, _
                    IgnorePrintAreas:=False, OpenAfterPublish:=False

'run process for format option 2
            Else:
                wbk.Sheets(Array(Page1, Page2, Page3)).Select
                ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
                    ThisWorkbook.Path & "\pdfsgohere" & "\" & wbk.Name, _
                    Quality:=xlQualityStandard, IncludeDocProperties:=False, _
                    IgnorePrintAreas:=False, OpenAfterPublish:=False
            'Tried killing the finished document to improve function
                Dim xFullName As String
                xFullName = Application.ActiveWorkbook.FullName
                ActiveWorkbook.Saved = True
                Application.ActiveWorkbook.ChangeFileAccess xlReadOnly
                Kill xFullName
                Application.ActiveWorkbook.Close False

            End If
    ' Close workbook - didn't seem to help (can't do it when the workbook is gone)
       'wbk.Close SaveChanges:=False

    ' Get next filename
    strXLFile = Dir
Loop
Application.ScreenUpdating = True
MsgBox "All Done"

感谢您的帮助。这几天我一直在努力解决这个问题。

【问题讨论】：

“然后它崩溃了” - 它究竟是如何崩溃的？

我更新了我的帖子以澄清这一点。谢谢。

这不一定是崩溃 - 听起来只是 忙。如果您将Stop 甚至只是DoEvents 放在循环中会怎样？

循环中的Debug.Print "something" 行也很有帮助，这样您就可以在即时窗口 (CTRL+G) 中看到它的进展情况。 Here is more on that 和来自令人惊叹的 Chip Pearson 的其他调试技巧。

如果 CPU 或 RAM 过载，以这种方式让给处理器不会有帮助吗？我的电脑没有报告任何超过 50% 的功能使用率，并且在执行代码时没有其他任何东西很慢。它只影响 Excel 文档（即使是那些与代码无关的文档）。我会尝试一个 DoEvents 看看它是否有帮助。

【参考方案1】：

这对我运行了 >30 个文件，没有问题：

Sub Convert2PDF()

    Dim strFolder As String, strXLFile As String
    Dim strPDFFile As String
    Dim wbk As Workbook
    Dim lngPos As Long
    Dim pages(1 To 4) As String
    Dim shtBatch As Worksheet, arr

    Set shtBatch = ThisWorkbook.Sheets("Batch PDF Printer")
    shtBatch.Range("A2:C2").Calculate '<< assume this was the point of resetting the formulas?
    pages(1) = shtBatch.Range("A2").Value
    pages(2) = shtBatch.Range("B2").Value
    pages(3) = shtBatch.Range("C2").Value

    'what pages to print?  Only need to do this once
    arr = IIf(Len(pages(3)) = 0, Array(pages(1), pages(2)), _
                                 Array(pages(1), pages(2), pages(3)))

    strFolder = ThisWorkbook.Path & "\putfileshere\"
    strXLFile = Dir(strFolder & "*.xls*")

    Do While strXLFile <> ""

        Set wbk = Workbooks.Open(Filename:=strFolder & strXLFile, ReadOnly:=True)

        lngPos = InStrRev(strXLFile, ".")
        strPDFFile = Left(strXLFile, lngPos) & "pdf"

        wbk.Sheets(arr).Select
        ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _
            Filename:=ThisWorkbook.Path & "\pdfsgohere\" & strPDFFile, _
            Quality:=xlQualityStandard, IncludeDocProperties:=False, _
            IgnorePrintAreas:=False, OpenAfterPublish:=False

        wbk.Close False

        strXLFile = Dir
    Loop

    MsgBox "All Done"

End Sub

【讨论】：

Tim，您尝试完成这项工作并根据我的特定项目调整变量真是太棒了。另外，感谢您向我介绍 IIF。我在那个手术中磕磕绊绊，因为我不知道它的存在。不幸的是，您的简化代码产生了几乎相同的结果。生成了 14 个 PDF - 然后主工作簿崩溃并自动重新启动。但是，您的代码不会使整个 Excel 应用程序和所有打开的工作簿崩溃。这是一个改进。非常感谢您花时间来解决这个问题。我将尝试更多地为它提供不同/新的工作簿。

第二次运行在冻结整个应用程序之前生成了 13 个 PDF。在杀死它并再次尝试之前，我看到我的处理器使用率飙升。我在运行时使用了大约 40-50% 的 3.63 GHz，但是在它冻结之后计算机真的开始尝试处理一些东西。导出的工作表中有很多公式和 VBA 计算。这可能是原因吗？当宏打开要导出的书时，应该如何禁用这些？

我的示例工作簿非常简​​单，因此您的 CPU 负载可能主要是由于连续打开多个“重”工作簿。如果您注释掉导出到 pdf 步骤会发生什么？它仍然失败吗？

我离开了 wbk.Sheets(arr).Select 并注释了所有的导出参数。奇迹般有效。所以也许这不是 VBA 问题，而是 Adob​​e 问题？

更新了 Adob​​e。没有变化。

【参考方案2】：

即使您的可见系统 RAM 没有超载，Excel 应用程序的内部容量似乎也会在短时间内超出。在应用程序自动重启之前，我终于能够查看消息框“系统资源不足，无法完全显示”。尝试简化循环访问的工作簿。如果您的工作簿需要一段时间才能启动，这可能表明后台进程繁重（计算和 VBA 订阅）。 DoEvents 可以通过要求更多的处理时间来帮助代码更顺畅地运行，以便系统可以对其需求进行排序。最终，

Application.Calculation = xlManual

循环顶部足以减少 20 gig 系统的计算需求（我从没想过会超载）。

【参考方案3】：

如果您在导出文件中有链接图像。

导出的链接图像会在内核中留下一点或字节，这些会累积并最终破坏 excel。

我在 Internet 上仅在 1 个地方找到了这个解决方案，但我再也找不到它了，但它通过删除链接图像让我从 200 到 1000 个 VBA 宏循环。

VBA 代码中没有任何帮助，我使用了暂停、保存工作簿以清除内存、禁用事件等...

我在这里写了我的问题的答案：https://***.com/a/53600884/10069870

如果您的导出文件中没有链接图像，请忽略 :)