Outlook VBA. Open a PDF document and find a word inside it.

[Su_80]

Hello,

I'm trying open a PDF document (attached document in eMail) with VBA and find a word inside it. If this word exist on it then "category = Red"
Is it possible in Outlook VBA? I don't find examples about it.

(code for example from Graham Mayor, gmayor).


Public Sub PDF_eMails()

'==========================================
'Declare variables:

Dim myNameSpace As Outlook.NameSpace
Dim myInbox As Outlook.Folder
'Dim myDestFolder As Outlook.Folder

'Set variables:
Set myNameSpace = Application.GetNamespace("MAPI")
Set myInbox = myNameSpace.GetDefaultFolder(olFolderInbox)
'Set myDestFolder = myInbox.Folders("CHECK")

'===========================================

'Declare the variable MyItem but don't set it:

Dim myItem As Outlook.MailItem


For Each myItem In Application.ActiveExplorer.Selection

If myItem.UnRead Then


If "WORD EXIST IN PDF" Then

myItem.Categories = "Red"
myItem.Save
End If


End If

Next myItem 'This loops onto the next item in the selection or folder,
'so it checks them all automatically.

End Sub

[gmayor]

This is not as simple as you might imagine, and will only work if the PDF attachment is editable in Word, and not all are.
You need to download the attachment, save it as a temporary file. Open that file in Word to run the search, then process the message, close and delete the temporary downloaded file. Inevitably that process can take a while to run.
The code below includes a test macro to test the code on a selected and unread message that has a PDF attachment. The main code can be run from a rule to process the messages as they arrive.

Option Explicit

Private Const sWordtoFind = "The word to find"    'the word to find

Sub Test()
'Graham Mayor - https://www.gmayor.com - Last updated - 30 Jan 2021
Dim olMsg As MailItem
    On Error Resume Next
    Select Case Outlook.Application.ActiveWindow.Class
        Case olInspector
            Set olMsg = ActiveInspector.currentItem
        Case olExplorer
            Set olMsg = Application.ActiveExplorer.Selection.Item(1)
    End Select
    PDF_eMails olMsg
lbl_Exit:
    Exit Sub
End Sub

Sub ProcessFolder()
'Graham Mayor - https://www.gmayor.com - Last updated - 30 Jan 2021
Dim olFolder As Folder
Dim olMsg As Object
Dim i As Integer
    Set olFolder = Session.GetDefaultFolder(olFolderDrafts)
    For i = olFolder.items.Count To 1 Step -1
        Set olMsg = olFolder.items(i)
        If TypeName(olMsg) = "MailItem" Then
            If olMsg.UnRead = True Then PDF_eMails olMsg
        End If
    Next i
    MsgBox "Process complete", vbExclamation
lbl_Exit:
    Set olFolder = Nothing
    Set olMsg = Nothing
    Exit Sub
End Sub

Private Sub PDF_eMails(olItem As MailItem)
'Graham Mayor - https://www.gmayor.com - Last updated - 30 Jan 2021
Dim olAtt As Attachment
Dim wdApp As Object
Dim wdDoc As Object
Dim oRng As Object
Dim sName As String, sPath As String

    sPath = Environ("USERPROFILE") & "\Desktop\"

    If olItem.Attachments.Count > 0 Then
        For Each olAtt In olItem.Attachments
            If Right(LCase(olAtt.FileName), 4) = ".pdf" Then
                sName = olAtt.FileName
                olAtt.SaveAsFile sPath & sName
                On Error Resume Next
                Set wdApp = GetObject(, "Word.Application")
                If Err Then
                    Set wdApp = CreateObject("Word.Application")
                End If
                On Error GoTo 0
                wdApp.Visible = True
                Set wdDoc = wdApp.documents.Open(sPath & sName)
                Set oRng = wdDoc.Range
                With oRng.Find
                    Do While .Execute(findText:=sWordtoFind, MatchCase:=False)
                        'olItem.Display
                        olItem.Categories = "Red Category"
                        olItem.Save
                        'olItem.Close olSave
                        wdDoc.Close 0
                        Exit Do
                    Loop
                End With
                For Each wdDoc In wdApp.documents
                    If wdDoc.Name = sName Then
                        wdDoc.Close
                        Exit For
                    End If
                Next wdDoc
                Exit For
            End If
        Next olAtt
        Kill sPath & sName
    End If
lbl_Exit:
    Set olAtt = Nothing
    Set wdApp = Nothing
    Set wdDoc = Nothing
    Set oRng = Nothing
    Exit Sub
End Sub

[Su_80]

Thanks so much @gmayor! I am trying to addapt the code with my macro, I'll tell you something more later. I think my PDF can get editing with word. Thanks again!