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! :clap: