You need to enable JavaScript to run this app.
优惠活动
大模型
产品
解决方案
定价
更多

使用VBA Acrobat API按文本拆分PDF时动态路径保存失败

VBA调用Acrobat API拆分PDF:动态路径保存失败,硬编码路径正常

我尝试通过VBA调用Acrobat API,根据页面中是否包含“.pdf”文本拆分PDF文件。目前遇到的问题是:使用动态字符串变量指定保存路径时,无法成功保存处理后的新PDF;但改用硬编码的固定路径时,保存操作完全正常。问题卡在删除页面后的新PDF保存环节。

相关代码

Extract_PDF函数

Function Extract_PDF()
    
    Dim aApp As Acrobat.CAcroApp
    Dim av_Doc As Acrobat.CAcroAVDoc
    Dim pdf_Doc As Acrobat.CAcroPDDoc '
    Dim newPDFdoc As Acrobat.CAcroPDDoc
    
    Dim Sel_Text As Acrobat.CAcroPDTextSelect
    Dim i As Long, j As Long
    Dim pageNum, Content
    Dim pageContent As Acrobat.CAcroHiliteList
    Dim found As Boolean
    Dim foundPage As Integer
    Dim PDF_Path As String
    Dim pdfName As String
    Dim folerPath As String
    
    Dim FileExplorer As FileDialog
    Set FileExplorer = Application.FileDialog(msoFileDialogFilePicker)
        
    With FileExplorer
        .AllowMultiSelect = False
        .InitialFileName = ActiveDocument.Path
        .Filters.Clear
        .Filters.Add "PDF File", "*.pdf"
        
        If .Show = -1 Then
            PDF_Path = .SelectedItems.Item(1)
            
        Else
            PagesLB = "Catch me Next Time ;)"
            PDF_Path = ""
            Exit Function
        End If
    End With
        
    Set aApp = CreateObject("AcroExch.App")
    Set av_Doc = CreateObject("AcroExch.AVDoc")
    
    If av_Doc.Open(PDF_Path, vbNull) <> True Then Exit Function
    
    
    While av_Doc Is Nothing
        Set av_Doc = aApp.GetActiveDoc
    Wend
                
        av_Doc.BringToFront
        aApp.Show
    
    Set pdf_Doc = av_Doc.GetPDDoc
    
    For i = pdf_Doc.GetNumPages - 1 To 0 Step -1
    
        Set pageNum = pdf_Doc.AcquirePage(i)
        Set pageContent = CreateObject("AcroExch.HiliteList")
        
        If pageContent.Add(0, 9000) <> True Then Exit Function
        Set Sel_Text = pageNum.CreatePageHilite(pageContent)
        
        Content = ""
        found = False
        
        For j = 0 To Sel_Text.GetNumText - 1
            Content = Content & Sel_Text.GetText(j)
            If InStr(1, Content, ".pdf") > 0 Then
                found = True
                foundPage = i
                pdfName = Content
                Exit For
            End If
        Next j

        If found Then
            
            PDF_Path = Left(PDF_Path, InStrRev(PDF_Path, "\")) & ValidWBName(pdfName)
                        
            Set newPDFdoc = CreateObject("AcroExch.PDDoc")
            Set newPDFdoc = av_Doc.GetPDDoc
            
                If newPDFdoc.DeletePages(0, i - 1) = False Then
                    Debug.Print "Failed"
                Else
                    Debug.Print "done"
                End If
                
                If newPDFdoc.Save(PDSaveFull, PDF_Path) = False Then
                
                    Debug.Print "Failed to save pdf "
                    Else
                    Debug.Print "Saved"
                End If
            
            newPDFdoc.Close
        
        End If
    
    Next i
        
        av_Doc.Close False
        aApp.Exit
            
        Set av_Doc = Nothing
        Set pdf_Doc = Nothing
        Set aApp = Nothing
    
End Function

ValidWBName函数

Function ValidWBName(agr As String) As String
    Dim RegEx As Object
    Set RegEx = CreateObject("VBScript.RegExp")
    With RegEx
        .Pattern = "[\/:\*?""<>\|]"
        .Global = True
        ValidWBName = .Replace(agr, "")
    End With
End Function

问题定位

保存步骤执行失败,控制台输出Failed to save pdf,对应代码段:

If newPDFdoc.Save(PDSaveFull, PDF_Path) = False Then

但将路径改为硬编码形式时,保存操作正常完成:

If newPDFdoc.Save(PDSaveFull, "C:\Users\MBA\Desktop\PDF Project 2\Murdoch_Michael__Hilary_PIA_19.pdf") = False Then

内容的提问来源于stack exchange,提问作者VBAbyMBA

相关产品推荐
方舟 Agent Plan

超全模态模型 × Harness 升级,最新支持 Deepseek-V4.1-Flash、GLM-5.3 系列、Doubao-Seedream-5.0-pro、Kimi-K3 (部分), 限时 9.9 元起

最近更新时间:2026.08.04 00:50:38