VBA报错'-2146959355(800800005)'：无此接口支持，求解决方案

问题背景 #

原本使用VBA脚本先通过Adobe将PDF转为Word文档，再转成纯文本文件，运行正常。现在尝试直接用Adobe生成可访问文本文件时，出现错误：Sudden Word vba error '-2146959355 (800800005)' No Such interface Supported，不确定是公司环境变更还是代码问题，原代码如下：

Sub LoopThroughFiles()
    
    Dim StrFile As String
    Dim pdfPath As String
    
    StrFile = Dir("C:\temp\PDFs\")
    fileRoot = "C:\temp\PDFs\"
    If Right(fileRoot, 1) <> "\" Then fileRoot = fileRoot & "\" 'ensure terminating \
    
    Do While Len(StrFile) > 0
        
        Debug.Print StrFile
        n = StrFile
        pdfPath = fileRoot & StrFile
        
        Debug.Print pdfPath
        
    'Convert to WordDoc
    success = ConvertPdf2(pdfPath, fileRoot & StrFile & ".doc")
    StrFile = Dir
    On Error Resume Next
        
    oWd.Quit
        
    'Convert to PlainText
    Debug.Print pdfPath & ".doc"

    success2 = GetTextFromWord(pdfPath & ".doc", n)
    
Loop
End Sub

'returns true if conversion was successful (based on whether `Open` succeeded or not)
Function ConvertPdf2(pdfPath As String, textPath As String) As Boolean
    Dim AcroXApp As Acrobat.AcroApp
    Dim AcroXAVDoc As Acrobat.AcroAVDoc
    Dim AcroXPDDoc As Acrobat.AcroPDDoc
    Dim jsObj As Object, success As Boolean

    Set AcroXApp = CreateObject("AcroExch.App")
    Set AcroXAVDoc = CreateObject("AcroExch.AVDoc")
    success = AcroXAVDoc.Open(pdfPath, "Acrobat") '<<< returns false if fails
    If success Then
    
Application.Wait (Now + TimeValue("0:00:2")) 'Helps PC have some time to go through data, can cause PC to freeze without

        Set AcroXPDDoc = AcroXAVDoc.GetPDDoc
        Set jsObj = AcroXPDDoc.GetJSObject
        jsObj.SaveAs textPath, "com.adobe.acrobat.doc"
        AcroXAVDoc.Close False
    End If
    AcroXApp.Hide
    AcroXApp.Exit
    ConvertPdf2 = success 'report success/failure
End Function

Function GetTextFromWord(DocStr As String, n)

    Dim filePath As String
    Dim fso As FileSystemObject
    Dim fileStream As TextStream
    Dim oWd As Object, oDoc As Object, fileRoot As String
    Const wdFormatText As Long = 2, wdCRLF As Long = 0
    
    Set fso = New FileSystemObject
    Set oWd = CreateObject("word.application")
    
    fileRoot = "C:\temp\PDFs" 'read this once
    If Right(fileRoot, 1) <> "\" Then fileRoot = fileRoot & "\" 'ensure terminating \
    
            Set oDoc = Nothing
            On Error Resume Next 'ignore error if no document...
            Set oDoc = oWd.Documents.Open(DocStr)
            On Error GoTo 0      'stop ignoring errors
            
            Debug.Print n
            If Not oDoc Is Nothing Then
                filePath = fileRoot & n & ".txt"  'filename
                Debug.Print filePath
                
                
        oDoc.SaveAs2 Filename:=filePath, _
        FileFormat:=wdFormatText, LockComments:=False, Password:="", _
        AddToRecentFiles:=False, WritePassword:="", ReadOnlyRecommended:=False, _
        EmbedTrueTypeFonts:=False, SaveNativePictureFormat:=False, SaveFormsData _
        :=False, SaveAsAOCELetter:=False, Encoding:=65001, InsertLineBreaks:=False _
        , AllowSubstitutions:=True, LineEnding:=wdCRLF, CompatibilityMode:=0
        
    oDoc.Close False
    
    End If
    oWd.Quit
                
   
    GetTextFromWord = success2
    
End Function

错误原因 #

• 错误800800005属于COM接口调用失败，常见原因包括：Adobe Acrobat的COM组件注册异常、版本更新后接口变更、公司环境限制了Office/Acrobat的自动化接口权限。
• 原代码逻辑存在缺陷：oWd.Quit被放在循环内部，导致每次循环都关闭Word实例，后续GetTextFromWord重新创建Word时容易触发接口冲突。

修复方案 #

方案1：直接用Adobe生成纯文本（跳过Word） #

修改代码，直接通过Adobe将PDF保存为纯文本格式，彻底规避Word的COM接口问题：

核心转换函数

'returns true if conversion was successful
Function ConvertPdfToText(pdfPath As String, textPath As String) As Boolean
    Dim AcroXApp As Acrobat.AcroApp
    Dim AcroXAVDoc As Acrobat.AcroAVDoc
    Dim AcroXPDDoc As Acrobat.AcroPDDoc
    Dim jsObj As Object, success As Boolean

    On Error GoTo ErrorHandler
    Set AcroXApp = CreateObject("AcroExch.App")
    Set AcroXAVDoc = CreateObject("AcroExch.AVDoc")
    success = AcroXAVDoc.Open(pdfPath, "Acrobat")
    
    If success Then
        '根据文件大小调整等待时间，避免加载不完整
        Application.Wait (Now + TimeValue("0:00:3"))
        Set AcroXPDDoc = AcroXAVDoc.GetPDDoc
        Set jsObj = AcroXPDDoc.GetJSObject
        '指定纯文本格式保存
        jsObj.SaveAs textPath, "com.adobe.acrobat.plain-text"
        AcroXAVDoc.Close False
    End If
    
Cleanup:
    On Error Resume Next
    AcroXApp.Hide
    AcroXApp.Exit
    Set AcroXPDDoc = Nothing
    Set AcroXAVDoc = Nothing
    Set AcroXApp = Nothing
    ConvertPdfToText = success
    Exit Function
    
ErrorHandler:
    success = False
    Resume Cleanup
End Function

主循环修改

Sub LoopThroughFiles()
    Dim StrFile As String
    Dim pdfPath As String, txtPath As String
    Dim fileRoot As String
    
    fileRoot = "C:\temp\PDFs\"
    If Right(fileRoot, 1) <> "\" Then fileRoot = fileRoot & "\"
    
    '仅遍历PDF文件，避免处理其他格式
    StrFile = Dir(fileRoot & "*.pdf")
    
    Do While Len(StrFile) > 0
        Debug.Print "处理文件: " & StrFile
        pdfPath = fileRoot & StrFile
        '生成对应TXT文件名，去掉原PDF后缀
        txtPath = fileRoot & Left(StrFile, InStrRev(StrFile, ".") - 1) & ".txt"
        
        '直接转换为纯文本
        success = ConvertPdfToText(pdfPath, txtPath)
        
        If success Then
            Debug.Print "转换成功: " & txtPath
        Else
            Debug.Print "转换失败: " & pdfPath
        End If
        
        StrFile = Dir
    Loop
End Sub

方案2：修复原代码的Word交互问题 #

如果必须保留转Word的流程，需修正代码逻辑并排查环境问题：

修正后的主循环与文本转换函数

Sub LoopThroughFiles()
    Dim StrFile As String
    Dim pdfPath As String, docPath As String
    Dim fileRoot As String
    Dim oWd As Object '将Word实例移到循环外，避免重复创建销毁
    
    fileRoot = "C:\temp\PDFs\"
    If Right(fileRoot, 1) <> "\" Then fileRoot = fileRoot & "\"
    
    '提前创建Word实例
    Set oWd = CreateObject("word.application")
    
    StrFile = Dir(fileRoot & "*.pdf")
    
    Do While Len(StrFile) > 0
        Debug.Print "处理文件: " & StrFile
        pdfPath = fileRoot & StrFile
        docPath = fileRoot & StrFile & ".doc"
        
        '转Word文档
        success = ConvertPdf2(pdfPath, docPath)
        
        If success Then
            '传入已创建的Word实例转纯文本
            success2 = GetTextFromWord(docPath, StrFile, fileRoot, oWd)
        End If
        
        StrFile = Dir
    Loop
    
    '循环结束后统一关闭Word
    oWd.Quit
    Set oWd = Nothing
End Sub

Function GetTextFromWord(DocStr As String, fileName As String, fileRoot As String, oWd As Object) As Boolean
    Dim filePath As String
    Dim oDoc As Object
    Const wdFormatText As Long = 2, wdCRLF As Long = 0
    
    GetTextFromWord = False
    Set oDoc = Nothing
    On Error Resume Next
    Set oDoc = oWd.Documents.Open(DocStr)
    On Error GoTo 0
    
    If Not oDoc Is Nothing Then
        '生成对应TXT文件名
        filePath = fileRoot & Left(fileName, InStrRev(fileName, ".") - 1) & ".txt"
        Debug.Print "保存文本: " & filePath
        
        oDoc.SaveAs2 Filename:=filePath, _
            FileFormat:=wdFormatText, LockComments:=False, Password:="", _
            AddToRecentFiles:=False, WritePassword:="", ReadOnlyRecommended:=False, _
            EmbedTrueTypeFonts:=False, SaveNativePictureFormat:=False, SaveFormsData _
            :=False, SaveAsAOCELetter:=False, Encoding:=65001, InsertLineBreaks:=False _
            , AllowSubstitutions:=True, LineEnding:=wdCRLF, CompatibilityMode:=0
        
        oDoc.Close False
        GetTextFromWord = True
    End If
End Function

环境排查步骤

1. 重新注册Word组件：以管理员身份打开命令提示符，执行winword.exe /regserver。
2. 检查Adobe Acrobat的COM组件：确保已安装Acrobat的完整版本（而非Reader），并重新注册Acrobat组件，执行Acrobat.exe /regserver。
3. 联系IT确认公司组策略是否限制了Office/Acrobat的自动化接口调用权限。

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