Suchfunktion für PDF Dokumente

[sunny01]

Hallo,

ich hoffe ihr könnt mir bei folgender Aufgabe weiterhelfen. Ich habe nachfolgend einen VBA Code, mit dem man ein in einer Zelle in Excel eingetragenes Wort nach Doppelklick auf diese Zelle in einem PDF Dokument, deren Namen in der linken nebenstehenden Zelle eingetragen ist, suchen kann. Diese Suchfunktion funktioniert leider nur bei einem zu suchenden Wort und nicht wenn Umlaute ä, ö, ü  in diesem Wort beinhaltet sind.

Hat jemand von Euch einen Lösungsvorschlag, wie ich im Code angeben kann, dass ebenfalls Satzteile (inklusive Leerstellen zwischen den Wörtern) inklusive Umlaute in den Wörtern im PDF Dokument gesucht werden können. 

Nachfolgend ist der Code: 

Code:

Sub PDF_Suche()
   
   pfad_zum_reader = "C:\Program Files (x86)\Adobe\Acrobat Reader DC\Reader\AcroRd32.exe"
   pfad_zur_datei = ActiveCell.Offset(0, -1).Value
   mycell = ActiveCell.Value
   ean = ".pdf"
   strPath = ActiveWorkbook.Path
   
   If Dir(strPath & pfad_zur_datei & ean) <> "" Then Shell pfad_zum_reader & " /A search=" & mycell & " " & strPath & pfad_zur_datei & ean, vbMaximizedFocus
   
End Sub

[Fennek]

Hallo,

ist es möglich eine Beispieldatei und das dazu gehörende Wunschergebnis zu zeigen?

mfg

(Ich werde auch Nicht-VBA-Lösungen versuchen)

[sunny01]

Hallo,

ich habe beiliegend eine Testumgebung mit einer Beispieldatei (zum Ausprobieren und Erweitern). Wichtig ist, dass die pdf Datei in einem Unterordner zum Speicherort der Excel Datei liegt.

---

zum Suchen bitte auf das Wort in Spalte B doppelklicken, dann wird das Wort in dem Dokument lt. Angabe in Spalte A gesucht.

[Fennek]

Hallo,

in einem ersten Test konnte ich die PDF-Datei mit LibreOffice öffnen und nach "Wintersemester" durchsuchen.

Dies sollte auch mit MW Word gehen, aber das werde ich frühestens morgen testen.

Was bedeutet "auch Satzteile"? Ist damit der Absatz gemeint? Das muss in einer programmierbaren Weise definiert sein.

Falls es nötig sein sollte: Auch Excel VBA kann MS Word steuern.

mfg

[sunny01]

Hallo,

es wäre wichtig für mich, wenn ich nach Satzteilen suchen könnte, z.B. im Text lt. voriger Anlage "Erläuterung zum Studienjahr". Dadurch könnte man eindeutige Textstellen im Dokument suchen lassen, da einzelne Wörter zumeist öfters im Text vorkommen.

[Fennek]

Hallo,

eine eher mittelmäßige Antwort:

MS Word kann das PDF importieren, es dauert aber relativ lange.

Per Hand zeigt die Suchfunktion 10 Treffer, aber bei meinen Versuchen mit Word-VBA "find" stürzte das Programm mehrfach ab.

Meine Versuche mit Sysinternals Suche in Binär-Dateien und Powershell (nur mit Zusatzmodulmöglich) waren erfolglos.

Jedenfalls habe ich keine Lust mehr.

mfg

[Fennek]

Hallo,

so könnte es gehen:

zuerst die PDF in docx konvertieren

Als Word-Makro kann man so die ganzen Paragraphen, die das Suchwort enthalten, ausgeben:

Code:

Sub T_5()
With ActiveDocument.Content.Find
    .Text = "Wintersemester"
    .Forward = True
    While .Execute = True
    i = i + 1: If i > 25 Then Stop
        .Parent.Select
        Set rng = Selection
        rng.Expand wdParagraph
        Debug.Print .Parent, rng
    Wend
End With
End Sub

Den Suchtext aus Excel zu holen und das Ergebnis zurück nach Excel zu bringen, ist nicht so schwer.

mfg

[00202]

Hallo, :19:

ich habe aus meinem Blog einmal diesen Code und dann noch jenen Code genommen - und anschließend zusammengewürfelt: :21:

Code:

Option Explicit
' Wenn Word nicht offen ist wird diese Variable auf True
' gesetzt und Word am Ende wieder geschlossen
' War Word schon offen, beleibt es das auch
Dim blnTMP As Boolean
'--------------------------------------------------------------------------
' Module    : Modul1
' Procedure : Main
' Author    : Case (Ralf Stolzenburg)
' Date      : 20.05.2019
' Purpose   : Aus PDF-Dateien etwas auslesen - Dokumente danach umbenennen
' Note      : Funktioniert erst ab Word 2013!!!!!!!!!!
'--------------------------------------------------------------------------
Public Sub Main()
    ' Dimensionieren der Variablen
    Dim objDocument As Object
    Const wdFindContinue = 1
    Dim strDatei As String
    Dim objRange As Object
    Dim strTMP As String
    Dim objFSO As Object
    Dim objDir As Object
    Dim strDir As String
    Dim objApp As Object
    Dim lngCalc As Long
    Dim lngRef As Long
    ' Wenn ein Fehler auftritt gehe zu der angegebenen Sprungmarke
    On Error GoTo Fin
    ' Die Excelapplikation wird ruhig gestellt
    With Application
        .ScreenUpdating = False
        .EnableEvents = False
        lngCalc = .Calculation
        lngRef = Application.ReferenceStyle
        .Calculation = xlCalculationManual
        .DisplayAlerts = False
    End With
    ' Der Objektvariablen objFSO das "FilesystemObject" zuweisen
    'Set objFSO = CreateObject("Scripting.FileSystemObject")
    ' Wenn Du einen Ordnerauswahldialog möchtest
    'Set objShell = CreateObject("Shell.Application")
    'Set varDir = objShell.BrowseForFolder(0, "Ordner", &H4000, 17)
    'If varDir Is Nothing Then Set objShell = Nothing: Exit Sub
    'strDir = varDir.Self.Path
    ' Datei in einem Unterordner DIESER Exceldatei
    strDir = ThisWorkbook.Path & "\Test\"
    'strDir = "C:\Temp\Los\"  ' Fester Pfad
    strDir = IIf(Right(strDir, 1) <> "\", strDir & "\", strDir)
    Set objApp = OffApp("Word")
    ' Word nicht sichtbar
    'Set objApp = OffApp("Word", False)
    If Not objApp Is Nothing Then
        strDatei = Dir$(strDir & "*.pdf", vbDirectory)
        Do While strDatei <> ""
            ' Word- Pdf-Dokument öffnen - ab Word 2013!!!!!
            Set objDocument = objApp.Documents.Open(strDir & strDatei)
            With objApp.Selection.Find
                .Forward = True
                ' Nach dem Text wird gesucht
                .Text = "Eignungsprüfung"
                While .Execute = True
                    'Set objRange = objApp.Selection.Bookmarks("\Line").Range
                    Set objRange = objApp.Selection.Bookmarks("\Para").Range
                    'Set objRange = objApp.Selection.Bookmarks("\Cell").Range
                    strTMP = strTMP & objRange.Text
                Wend
                objDocument.Close False
                Set objRange = Nothing
                Set objDocument = Nothing
            End With
            strDatei = Dir$()
        Loop
        Debug.Print strTMP
    Else
        MsgBox "Applikation nicht installiert!"
    End If
Fin:
    If Not objApp Is Nothing Then
        If blnTMP = True Then
            objApp.Quit
            blnTMP = False
        End If
    End If
    ' Objektvariablen leeren
    Set objFSO = Nothing
    Set objDocument = Nothing
    Set objApp = Nothing
    ' Die Applikation aufwecken
    With Application
        .ScreenUpdating = True
        .AskToUpdateLinks = True
        .EnableEvents = True
        .Calculation = lngCalc
        Application.ReferenceStyle = lngRef
        .DisplayAlerts = True
        .CutCopyMode = True
    End With
    ' Wenn ein Fehler auftritt gib ihn aus mit Fehlernummer und Beschreibung
    If Err.Number <> 0 Then MsgBox "Fehler: " & _
        Err.Number & " " & Err.Description
End Sub
'--------------------------------------------------------------------------
' Module    : Modul1
' Procedure : OffApp
' Author    : Case (Ralf Stolzenburg)
' Date      : 20.05.2019
' Purpose   : Start Applikation...
'--------------------------------------------------------------------------
Private Function OffApp(ByVal strApp As String, _
    Optional blnVisible As Boolean = True) As Object
    Dim objApp As Object
    On Error Resume Next
    Set objApp = GetObject(, strApp & ".Application")
    Select Case Err.Number
        Case 429
            Err.Clear
            Set objApp = CreateObject(strApp & ".Application")
            blnTMP = True
            If blnVisible = True Then
                On Error Resume Next
                objApp.Visible = True
                Err.Clear
            End If
    End Select
    On Error GoTo 0
    Set OffApp = objApp
    Set objApp = Nothing
End Function

Es gibt in Word auch Vordefinierte Textmarken. Mit denen kannst du bestimmen, wie viel du vom Suchtext sehen/ausgeben willst. :21:

• \Line --> ganze Zeile
  
• \Para --> ganzer Absatz
  
• \Cell --> ganze Zelle einer Tabelle
  

Steht im Link beschrieben.

Im Moment wird das Ergebnis im Direktbereich (STRG+G im VBA-Editor) ausgegeben. :21:

[sunny01]

Hallo,

zuerst einmal vielen Dank für Eure guten Vorschläge, ich werde diese noch ausprobieren.

Mir geht es im Prinzip gar nicht so sehr darum eine Textpassage automatisiert in ein anderes Programm zu übernehmen sondern darum, eine Textpassage im PDF Dokument durch Angabe der Textpassage in Excel automatisch im PDF Dokument suchen und markieren zu lassen. Habt ihr ev. eine Idee, wie mein jetziger Code ev. noch insofern angeglichen werden kann, dass er nicht nur ein Suchwort sondern mehrere aufeinanderfolgende Wörter (trotz der Leerzeichen dazwischen) erkennt?

[Fennek]

Hallo,

zwei rhetorische Fragen:

- wenn die Mehr-Wort-Suche so wichtig ist, warum ist das Beispiel nur mit 1 Word
- warum zweifels Du, dass der Code nicht auch für mehrere Worte gehen sollte

Code:

Const sTx = "Bachelor of"

Sub T_5()
With ActiveDocument.Content.Find
    .Text = sTx '"Wintersemester"
    .Forward = True
    While .Execute = True
        '.Parent.Select
        Set rng = Range(.Parent.Start, .Parent.End) 'Selection
        rng.Expand wdParagraph
        Debug.Print .Parent, rng
    Wend
End With
End Sub

Die Variable "sTx" sollte aus Excel geholt werden. Dieser Code vermeidet "select", das bei der Ansteuerung von XL oft Probleme macht.

mfg