使用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
相关产品推荐
相关产品推荐

