从Excel中搜索PDF文件中的字符串



我使用VBA脚本在PDF文件中的表中搜索字符串。该脚本在从Word打电话时起作用,但在从Excel中调用时不工作。

我的PDF有很多表,目标是获取包含特定字符串的表的表号。

Sub FindTableno()
Dim oTbl As Table
Dim oRow As Row
Dim oCell As Cell
Dim tblno As Integer
On Error Resume Next
    ' Create a "FileDialog" object as a File Picker dialog box.
    Dim fd As Office.FileDialog
    Set fd = Application.FileDialog(msoFileDialogFilePicker)
    Dim sfileName As String
    
    With fd
        .AllowMultiSelect = False
        .Filters.Clear
        .Title = "Select a PDF File"
        .Filters.Add "All PDF Documents", "*.pdf?", 1
    
        If .Show = True Then
            sfileName = Dir(.SelectedItems(1))      ' Get the file.
        End If
    End With
    
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    
    If Trim(sfileName) <> "" Then
        Dim objWord As Object       ' Create a Word object.
        Set objWord = CreateObject("Word.Application")
        objWord.Visible = False      ' Do not show the file.
        
        ' Create a Document object and open the Word file.
        Dim objDoc As Word.Document
        Set objDoc = objWord.Documents.Open(FileName:=fd.InitialFileName & sfileName, Format:="PDF Files", ConfirmConversions:=False)
    
        ' Search within tables in selected PDF file
        objDoc.Activate
    
        If ActiveDocument.Tables.Count > 0 Then
            tblno = 1
            For Each oTbl In ActiveDocument.Tables
                For Each oRow In oTbl.Rows
                    For Each oCell In oRow.Cells
                        oCell.Select
                        Selection.Find.Execute FindText:="Nutrition Information"
                        If Selection.Find.Found = True Then
                            MsgBox (tblno)
                            Exit Sub
                        Else
                        End If
                    Next
                Next
                tblno = tblno + 1
            Next
        End If
        MsgBox ("Not Found, Total Tables Searched:" & ActiveDocument.Tables.Count)
        
    End If
    Dim X As Variant
    X = Shell("powershell.exe kill -processname winword", 1)
End Sub

主要问题是在此部分使用oCell.Select,然后使用Selection.Find。在这种情况下,Selection是指Excel中的选定单元格!这是因为您在这里没有指定与Word的任何关系,因此Excel假设您是指Excel中的选定单元格。

我建议阅读如何避免在Excel VBA中使用SELECT。对于单词VBA代码也是有效的。

也不使用.Activate,否则您会遇到类似的问题。始终直接引用工作表或文档:

If objDoc.Tables.Count > 0 Then
    tblno = 1
    For Each oTbl In objDoc.Tables
        For Each oRow In oTbl.Rows
            For Each oCell In oRow.Cells
                oCell.Range.Find.Execute FindText:="Nutrition Information"
                If oCell.Range.Find.Found = True Then
                    MsgBox (tblno)
                    Exit Sub
                End If
            Next
        Next
        tblno = tblno + 1
    Next
End If
MsgBox ("Not Found, Total Tables Searched:" & objDoc.Tables.Count)

谢谢 @pᴇʜ,这对我有用

Sub FindTableno()
Dim oTbl As Table
Dim oRow As Row
Dim oCell As Cell
Dim tblno As Integer
' Create a "FileDialog" object as a File Picker dialog box.
Dim fd As Office.FileDialog
Set fd = Application.FileDialog(msoFileDialogFilePicker)
Dim sfileName As String
With fd
    .AllowMultiSelect = False
    .Filters.Clear
    .Title = "Select a PDF File"
    .Filters.Add "All PDF Documents", "*.pdf?", 1
    If .Show = True Then
        sfileName = Dir(.SelectedItems(1))      ' Get the file.
    End If
End With
Application.ScreenUpdating = True
Application.DisplayAlerts = True
If Trim(sfileName) <> "" Then
    Dim objWord As Object       ' Create a Word object.
    Set objWord = CreateObject("Word.Application")
    objWord.Visible = True      ' Do not show the file.
' Create a Document object and open the Word file.
Dim objDoc As Word.Document
'Set objDoc = objWord.Documents.Open(Filename:=fd.InitialFileName & sfileName, Format:="PDF Files", ConfirmConversions:=False)
 Set objDoc = objWord.Documents.Open(Filename:=fd.InitialFileName & sfileName, Format:="PDF Files", ConfirmConversions:=False)
' Search within tables in selected PDF file
If objDoc.Tables.count > 0 Then
    tblno = 1
    For Each oTbl In objDoc.Tables
        For Each oRow In oTbl.Rows
            For Each oCell In oRow.Cells
            pos = InStr(oCell.Range.Text, "Nutrition Information ")
            If pos <> 0 Then
            GoTo line1
            End If
        'Else
        'End If
        Next
        Next
        tblno = tblno + 1
        Next
    End If
    MsgBox ("Not Found, Total Tables Searched:" & objDoc.Tables.count)
    'MsgBox (oCell.Range.Text)
End If
line1:
MsgBox (tblno)
End Sub

最新更新