【Excel VBA / Outlook】メールに添付された PDF ファイルのテキストを取得する方法

備忘のため、メールに添付された PDF のテキストを抽出する方法について残しておきます。
Outlook メールが対象で、Excel VBA を使用します。

なお、Adobe Acrobat Pro は不要です。Outlook と Excel があれば実行できます。

1. 参照設定

参照設定として、次のライブラリを読み込むようにしておきます。
・Microsoft Outlook 16.0 Object Library

16.0 というのは、アプリケーションのバージョンなので、環境によって異なる場合もあります。

2. 添付 PDF のテキストを取得するサンプルコード

先にサンプルコードを掲載します（説明は後述）。

なお、これらのコードは、受信トレイにあるメール全てを対象として、添付されている PDF ファイルのテキストデータを取得するものです。
メール数が1000以上あるような場合は、このまま実行せず、ループ数を調整するようにしてください。

2-1. 確認メッセージ表示の制御無し（シンプルなコード）

添付PDFからテキストを取得する

Sub GetPdfTextFromReceivedEmail_Sample()
    Dim i As Long, j As Long

    Dim objOutlook As New Outlook.Application 'Outlookオブジェクト生成
    Dim myNamespace As Outlook.Namespace: Set myNamespace = objOutlook.GetNamespace("MAPI") 'Outlook の NameSpace オブジェクトを取得
    Dim myFolder As Folder: Set myFolder = myNamespace.GetDefaultFolder(olFolderInbox) '受信トレイフォルダーを取得

    Dim wordApp As Object: Set wordApp = CreateObject("Word.Application") '新しいWORDアプリケーションオブジェクトを生成
    wordApp.Visible = True 'Wordアプリケーションを表示する
    Dim doc As Object 'ワードファイルを１つ格納するオブジェクト変数

    On Error Resume Next '取得時にエラーが出る場合を回避（配信不能のお知らせメールなど）
    For i = 1 To myFolder.Items.Count '受信トレイのメール数だけループする
        Dim mailItem As MailItem: Set mailItem = myFolder.Items.Item(i)
        Debug.Print mailItem.SenderEmailAddress '送信者アドレス
        Debug.Print mailItem.ReceivedTime '受信時間
        Debug.Print mailItem.SentOn '送信時間
        Debug.Print mailItem.Subject '件名

        Dim fileName As String
        For j = 1 To mailItem.Attachments.Count '添付ファイルの数だけループする
            fileName = ThisWorkbook.Path & "\" & mailItem.Attachments.Item(j).fileName 'データを保存するパス名を指定
            mailItem.Attachments.Item(j).SaveAsFile fileName '添付ファイルを保存する

            If Right(fileName, 4) = ".pdf" Then '添付ファイルがPDFファイルの場合
                Set doc = wordApp.Documents.Open(fileName) 'PDFファイルを開く
                Debug.Print doc.Content.Text 'WORDファイルのテキストを取得（出力）
                doc.Close False 'ドキュメントを閉じる（False=保存せずに閉じる）
            End If

            Kill fileName '保存した添付ファイルを削除（ファイルを残す場合はこの１行を削除）
        Next j
    Next i
    On Error GoTo 0

    wordApp.Quit 'Wordアプリケーションを終了する
    Set wordApp = Nothing 'オブジェクトの解放
End Sub

これで、一応動作しますが、WORD で PDF を開く際に、次のような確認メッセージが表示されてしまいます。

次に、このメッセージを回避するサンプルコードを掲載しておきます。

2-2. 確認メッセージを表示させない例（完成形）

添付PDFからテキストを取得する（確認メッセージを表示をしない）

'警告メッセージを表示せずに添付PDFからテキストを取得する
Sub GetPdfTextFromReceivedEmail()
    Dim i As Long, j As Long

    Dim objOutlook As New Outlook.Application 'Outlookオブジェクト生成
    Dim myNamespace As Outlook.Namespace: Set myNamespace = objOutlook.GetNamespace("MAPI") 'Outlook の NameSpace オブジェクトを取得
    Dim myFolder As Folder: Set myFolder = myNamespace.GetDefaultFolder(olFolderInbox) '受信トレイフォルダーを取得

    Dim wordApp As Object: Set wordApp = CreateObject("Word.Application") '新しいWORDアプリケーションオブジェクトを生成
    wordApp.Visible = True 'Wordアプリケーションを表示する（無くとも良いが念のため残しておく）
    Dim doc As Object 'ワードファイルを１つ格納するオブジェクト変数

    Dim wordVer As String: wordVer = wordApp.Application.Version 'WORDアプリケーションのバージョンを取得（[15.0]や[16.0]など）
    Dim regValue As Long: regValue = GetRegValue("DisableConvertPdfWarning", wordVer) 'PDF変換に関するレジストリ値を取得
    If regValue <= 0 Then Call SetRegValue("DisableConvertPdfWarning", 1, wordVer) '警告が出る設定であればレジストリ値を[1]に変更

    On Error Resume Next '取得時にエラーが出る場合を回避（配信不能のお知らせメールなど）
    For i = 1 To myFolder.Items.Count '受信トレイのメール数だけループする
        Dim mailItem As MailItem: Set mailItem = myFolder.Items.Item(i)
        Debug.Print mailItem.SenderEmailAddress '送信者アドレス
        Debug.Print mailItem.ReceivedTime '受信時間
        Debug.Print mailItem.SentOn '送信時間
        Debug.Print mailItem.Subject '件名

        Dim fileName As String
        For j = 1 To mailItem.Attachments.Count '添付ファイルの数だけループする
            fileName = ThisWorkbook.Path & "\" & mailItem.Attachments.Item(j).fileName 'データを保存するパス名を指定
            mailItem.Attachments.Item(j).SaveAsFile fileName '添付ファイルを保存する

            If Right(fileName, 4) = ".pdf" Then '添付ファイルがPDFファイルの場合
                Set doc = wordApp.Documents.Open(fileName:=fileName, ConfirmConversions:=False) 'PDFファイルを開く
                Debug.Print doc.Content.Text 'WORDファイルのテキストを取得（出力）
                doc.Close False 'ドキュメントを閉じる（False=保存せずに閉じる）
            End If

            Kill fileName '保存した添付ファイルを削除（ファイルを残す場合はこの１行を削除）
        Next j
    Next i
    On Error GoTo 0

    If regValue <= 0 Then Call SetRegValue("DisableConvertPdfWarning", 0, wordVer) 'レジストリ値を[0]に戻す

    wordApp.Quit 'Wordアプリケーションを終了する
    Set wordApp = Nothing 'オブジェクトの解放
End Sub

'レジストリの値を取得（数値型）
Function GetRegValue(name As String, wordVer As String) As Long
    Dim wshShell As Object: Set wshShell = CreateObject("WScript.Shell") 'WshShellオブジェクトを作成
    Dim regKey As String: regKey = "HKEY_CURRENT_USER\SOFTWARE\Microsoft\Office\" & wordVer & "\Word\Options\" 'レジストリキーの格納場所
    On Error Resume Next
    GetRegValue = wshShell.RegRead(regKey & name) 'RegReadメソッドでレジストリの値を取得
    If Err.Number <> 0 Then GetRegValue = -1 'エラーが生じた場合（不存在の場合）は[-1]を返す
    On Error GoTo 0
    Set wshShell = Nothing 'WshShellオブジェクトの解放
End Function

'レジストリの値を設定（数値型）
Sub SetRegValue(name As String, newValue As Long, wordVer As String)
    Dim wshShell As Object: Set wshShell = CreateObject("WScript.Shell")
    Dim regKey As String: regKey = "HKEY_CURRENT_USER\SOFTWARE\Microsoft\Office\" & wordVer & "\Word\Options\"
    wshShell.RegWrite regKey & name, newValue, "REG_DWORD" 'RegWriteメソッドでレジストリを設定
    Set wshShell = Nothing
End Sub

以上のコードで、イミディエイトウィンドウに、PDF ファイルのテキストが出力されれば成功です。
実際には、取得したテキストを変数などに格納した上で、必要な処理を行うということになると思います。

3. 簡単な説明

3-1. 添付 PDF ファイルの保存

添付ファイルを保存しているのは、次の部分です。
一時的に保存するのは、後の処理で WORD アプリケーションで開くためです。

Sample

    Dim fileName As String
    For j = 1 To mailItem.Attachments.Count '添付ファイルの数だけループする
        fileName = ThisWorkbook.Path & "\" & mailItem.Attachments.Item(j).fileName 'データを保存するパス名を指定
        mailItem.Attachments.Item(j).SaveAsFile fileName '添付ファイルを保存する
        '省略（保存したPDFファイルに対する処理を行う）
        Kill fileName '保存した添付ファイルを削除（ファイルを残す場合はこの１行を削除）
    Next j

mailItem に１つのメールアイテムオブジェクトが格納されています。

① 添付ファイルの個数を取得
mailItem.Attachments.Count で、添付ファイルの個数を取得しています。

② 添付ファイル名を取得
mailItem.Attachments.Item(j) で、添付ファイルを一つずつ取得しています。
mailItem.Attachments.Item(j).fileName で添付ファイルのファイル名が取得できます。
（なお、この添付ファイルオブジェクトの戻り値がファイル名となるため mailItem.Attachments.Item(j) だけでもファイル名は取得できます。）

③ 添付ファイルの保存
mailItem.Attachments.Item(j).SaveAsFile fileName でファイルの保存ができます。
引数で指定した fileName が、保存されるファイルのフルパスとなります。

3-2. PDF からテキストを取得

PDF ファイルからテキストを取得しているのは次の部分です。

Sample

    If Right(fileName, 4) = ".pdf" Then '添付ファイルがPDFファイルの場合
        Set doc = wordApp.Documents.Open(fileName) 'PDFファイルを開く
        Debug.Print doc.Content.Text 'WORDファイルのテキストを取得（出力）
        doc.Close False 'ドキュメントを閉じる（False=保存せずに閉じる）
    End If

① PDF を WORD ファイルで開く
Set doc = wordApp.Documents.Open(fileName) で、一時的に保存した PDF ファイルを WORD で開いて、オブジェクト変数 doc に格納しています。

② WORD ファイルからテキスト全文を取得する
doc.Content.Text で、開いた WORD ファイルからテキスト全文を取得しています（このあたりの詳細はこちらの記事を参照してください）。

3-3. 確認メッセージを出さないようにする処理

WORD から PDF を開く際に、確認メッセージを非表示にするかどうかの情報は、Windows のレジストリに記録されています。
このレジストリを VBA から操作することで、確認メッセージの制御をすることが可能となります。

＜確認メッセージに関する設定値＞
この確認メッセージを表示するか否かの設定は、DisableConvertPdfWarning という名前（キー）で設定されています（このキーは最初は存在していません）。

データ（値）	設定内容
（キー不存在）	確認メッセージを表示する（デフォルト）
0x00000000 (0)	確認メッセージを表示する
0x00000001 (1)	確認メッセージを表示しない（無効にする）

このあたりの詳細は「PDF を WORD に変換してテキストを取得する」という記事に書きましたので、必要に応じて参照してください。

なお、レジストリの書き換えはアプリケーションの動作不良などを起こすなどの危険を伴いますので、自己責任で、影響が把握できている内容のみ操作するようにしてください。

サンプルコードのうち関係する部分は、次のとおりです。
レジストリの値を取得する GetRegValue 関数と、レジストリの書き換えを行う SetRegValue 関数を作成して処理を行っています。

Sample

'警告メッセージを表示せずに添付PDFからテキストを取得する
Sub GetPdfTextFromReceivedEmail()
    '省略
    Dim wordVer As String: wordVer = wordApp.Application.Version 'WORDアプリケーションのバージョンを取得（[15.0]や[16.0]など）
    Dim regValue As Long: regValue = GetRegValue("DisableConvertPdfWarning", wordVer) 'PDF変換に関するレジストリ値を取得
    If regValue <= 0 Then Call SetRegValue("DisableConvertPdfWarning", 1, wordVer) '警告が出る設定であればレジストリ値を[1]に変更

    '省略（PDFをWORDで開く処理を行う）

    If regValue <= 0 Then Call SetRegValue("DisableConvertPdfWarning", 0, wordVer) 'レジストリ値を[0]に戻す
    '省略
End Sub

'レジストリの値を取得（数値型）
Function GetRegValue(name As String, wordVer As String) As Long
    Dim wshShell As Object: Set wshShell = CreateObject("WScript.Shell") 'WshShellオブジェクトを作成
    Dim regKey As String: regKey = "HKEY_CURRENT_USER\SOFTWARE\Microsoft\Office\" & wordVer & "\Word\Options\" 'レジストリキーの格納場所
    On Error Resume Next
    GetRegValue = wshShell.RegRead(regKey & name) 'RegReadメソッドでレジストリの値を取得
    If Err.Number <> 0 Then GetRegValue = -1 'エラーが生じた場合（不存在の場合）は[-1]を返す
    On Error GoTo 0
    Set wshShell = Nothing 'WshShellオブジェクトの解放
End Function

'レジストリの値を設定（数値型）
Sub SetRegValue(name As String, newValue As Long, wordVer As String)
    Dim wshShell As Object: Set wshShell = CreateObject("WScript.Shell")
    Dim regKey As String: regKey = "HKEY_CURRENT_USER\SOFTWARE\Microsoft\Office\" & wordVer & "\Word\Options\"
    wshShell.RegWrite regKey & name, newValue, "REG_DWORD" 'RegWriteメソッドでレジストリを設定
    Set wshShell = Nothing
End Sub

以上です。
何らかの参考となれば幸いです。