如何解决转换大PDF时出现的'Microsoft Excel等待OLE操作完成'错误？

我尝试将PDF文件转换为Excel文件，转换小文件时一切正常，但处理300页左右的大PDF时，出现了“Microsoft Excel is waiting for another application to complete an ole action”错误。已尝试调整设置，也使用了Application.wait和Application.DisplayAlerts = False，但均无效果。

原代码 #

Option Explicit

Sub PDF_To_Excel()

Dim setting_sh As Worksheet
Set setting_sh = ThisWorkbook.Sheets("Setting")

Dim pdf_path As String
Dim excel_path As String

pdf_path = setting_sh.Range("E11").Value
excel_path = setting_sh.Range("E12").Value

Dim fso As New FileSystemObject
Dim fo As Folder
Dim f As File

Set fo = fso.GetFolder(pdf_path)

Dim wa As Object
Dim doc As Object
Dim wr As Object

Set wa = CreateObject("word.application")

wa.Visible = True

Dim nwb As Workbook
Dim nsh As Worksheet

For Each f In fo.Files
Set doc = wa.documents.Open(f.Path, False, Format:="PDF Files")
Set wr = doc.Paragraphs(1).Range
wr.WholeStory

Set nwb = Workbooks.Add
Set nsh = nwb.Sheets(1)
wr.Copy

nsh.Paste
nwb.SaveAs (excel_path & "\" & Replace(f.Name, ".pdf", ".xlsx"))

doc.Close False
nwb.Close False
Next

wa.Quit

MsgBox "Done"

End Sub

问题原因 #

这个错误本质是Word处理大PDF时耗时过长，Excel与Word的OLE通信超时。原代码直接一次性复制粘贴大文档，且没有等待Word完成加载/处理就继续操作，容易触发超时。

解决办法与优化代码 #

以下是针对性的优化方案，核心是增加动态等待机制、减少资源占用、稳定OLE通信：

Option Explicit

Sub PDF_To_Excel()
    Dim setting_sh As Worksheet
    Set setting_sh = ThisWorkbook.Sheets("Setting")

    Dim pdf_path As String
    Dim excel_path As String
    pdf_path = setting_sh.Range("E11").Value
    excel_path = setting_sh.Range("E12").Value

    Dim fso As New FileSystemObject
    Dim fo As Folder
    Dim f As File
    Set fo = fso.GetFolder(pdf_path)

    Dim wa As Object
    Dim doc As Object
    Dim wr As Object
    Set wa = CreateObject("word.application")
    wa.Visible = False ' 隐藏Word，减少界面渲染资源占用
    wa.DisplayAlerts = False ' 关闭Word警告提示

    ' 优化Excel运行环境，减少干扰
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Application.EnableEvents = False

    Dim nwb As Workbook
    Dim nsh As Worksheet

    For Each f In fo.Files
        ' 打开PDF并等待Word完全加载文档
        Set doc = wa.documents.Open(f.Path, False, Format:="PDF Files")
        Do While wa.BackgroundSavingStatus > 0 Or doc.ReadyState <> 4 ' 4=wdReadyStateComplete
            DoEvents ' 释放系统资源，让Word继续处理
        Loop

        ' 直接选择文档全部内容，替代原逻辑
        Set wr = doc.Content
        wr.Copy

        ' 等待剪贴板内容就绪，避免提前粘贴
        Do Until Clipboard_HasText
            DoEvents
        Loop

        Set nwb = Workbooks.Add
        Set nsh = nwb.Sheets(1)
        ' 指定粘贴类型，提升稳定性
        nsh.Range("A1").PasteSpecial Paste:=xlPasteAll

        nwb.SaveAs excel_path & "\" & Replace(f.Name, ".pdf", ".xlsx"), FileFormat:=xlOpenXMLWorkbook
        doc.Close False
        nwb.Close False
    Next

    ' 恢复所有默认设置
    wa.Quit
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    Application.EnableEvents = True

    MsgBox "Done"
End Sub

' 辅助函数：检测剪贴板是否包含文本内容
Private Function Clipboard_HasText() As Boolean
    Dim hClip As LongPtr
    Dim result As Boolean
    result = False
    If OpenClipboard(0&) Then
        result = IsClipboardFormatAvailable(49152) ' 49152=Unicode文本格式
        CloseClipboard
    End If
    Clipboard_HasText = result
End Function

' 声明Windows API函数（64位Office兼容）
Private Declare PtrSafe Function OpenClipboard Lib "user32" (ByVal hwnd As LongPtr) As Long
Private Declare PtrSafe Function CloseClipboard Lib "user32" () As Long
Private Declare PtrSafe Function IsClipboardFormatAvailable Lib "user32" (ByVal wFormat As Long) As Long

额外优化建议 #

1. 拆分大PDF：如果上述优化仍有问题，可将300页PDF拆分为多个50-100页的小文件后再转换，降低单文件处理压力。
2. 改用专业工具：对于复杂格式的大PDF，Word的转文本效率有限，可尝试用Power Query导入PDF（Excel内置功能），或Adobe Acrobat的官方API，转换精度和稳定性更高。

内容的提问来源于stack exchange，提问作者Vladislav Mezentsev