Question

我正在编写一个打开pdf文档的代码，找到几个关键字并将文件名和位置复制到excel的活动页面。我使用了我在网上找到的代码并对其进行了一些修改。但是，当我运行它时，打开acrobat pro并告诉我无法找到该文档。然后给出如下错误消息：acrobat can not open document， runtime error '451'

我似乎无法找出问题所在，我会很乐意为任何人提供帮助。谢谢！这是我的代码：

Private Sub CommandButton1_Click()

Dim WordToFind  As String
Dim WordToFind1  As String
Dim WordToFind2  As String
Dim PDFPath     As String
Dim App         As Object
Dim AVDoc       As Object
Dim PDDoc       As Object
'Dim obDoc As Object
Dim JSO         As Object
Dim i           As Long
Dim j           As Long
Dim Word        As Variant
Dim Result      As Integer
Dim Result1      As Integer
Dim Result2      As Integer
Dim strpdf As String
Dim strFolder As String
Dim ws As Worksheet

'Specify the text you want to search.
WordToFind = "women empowerment"
WordToFind1 = "recognition"
WordToFind2 = "human recognition"

Dim fd As FileDialog
Set fd = Application.FileDialog(msoFileDialogFolderPicker)
With fd
.Title = "Select the folder that contains the documents."
If .Show = -1 Then
    strFolder = .SelectedItems(1) & "\"
Else
    MsgBox "You did not select the folder that contains the documents."
    Exit Sub
End If
End With

On Error Resume Next
If Err.Number <> 0 Then
    MsgBox "Could not create the Adobe Application object!", vbCritical, "Object Error"
    Set App = Nothing
    Exit Sub
End If

If Err.Number <> 0 Then
    MsgBox "Could not create the AVDoc object!", vbCritical, "Object Error"
    Set AVDoc = Nothing
    Set App = Nothing
    Exit Sub
End If

On Error GoTo 0

 'MkDir strFolder & "Processed"

 strpdf = Dir$(strFolder & "*.pdf")
 While strpdf <> ""
   'Open the PDF file.
   Set App = CreateObject("AcroExch.App")
   Set AVDoc = CreateObject("AcroExch.AVDoc")
   AVDoc.Open(strFolder, strpdf) = True

    Set PDDoc = AVDoc.GetPDDoc

    Set JSO = PDDoc.GetJSObject

    If Not JSO Is Nothing Then

        For i = 0 To JSO.numPages - 1

            For j = 0 To JSO.getPageNumWords(i) - 1

                Word = JSO.getPageNthWord(i, j)

                If VarType(Word) = vbString Then
           Result = StrComp(LCase(Word), LCase(WordToFind), vbTextCompare)
           Result1 = StrComp(LCase(Word), LCase(WordToFind1), vbTextCompare)
          Result2 = StrComp(LCase(Word), LCase(WordToFind2), vbTextCompare)

          If Result = 0 Or Result1 = 0 Or Result2 = 0 Then
               Set ws = Application.ActiveSheet
                    Dim xrow As Long
                    ActiveCell.Offset(xrow) = Dir$(strFolder & strpdf)
                    xrow = xrow + 1
                        Exit Sub
                    End If

                End If

            Next j

        Next i

        AVDoc.Close True

        App.Exit

        'Release the objects.
        Set JSO = Nothing
        Set PDDoc = Nothing
        Set AVDoc = Nothing
        Set App = Nothing

    End If

    App.Exit

    'Release the objects.
    Set AVDoc = Nothing
    Set App = Nothing

Wend
End Sub

搜索pdf中的文本并提取文件名和文件夹位置

0 个答案: