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

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

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

# 1. 参照設定

参照設定として、次のライブラリを読み込むようにしておきます。
・Microsoft Outlook 16.0 Object Library
![2021-08-22 152351.png](https://qiita-image-store.s3.ap-northeast-1.amazonaws.com/0/551412/3e856cd1-60b7-4505-ef08-2680e21503fa.png)
`16.0` というのは、アプリケーションのバージョンなので、環境によって異なる場合もあります。

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

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

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

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

```vb:添付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 を開く際に、次のような確認メッセージが表示されてしまいます。
![2021-08-22 150700.png](https://qiita-image-store.s3.ap-northeast-1.amazonaws.com/0/551412/26f778dc-ecd3-88e7-3c5c-a06b5f685725.png)
次に、このメッセージを回避するサンプルコードを掲載しておきます。

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

```vb:添付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 アプリケーションで開くためです。

```vb: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 ファイルからテキストを取得しているのは次の部分です。

```vb: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 ファイルからテキスト全文を取得しています（このあたりの詳細は[こちら](https://qiita.com/t-yama-3/items/0b9dc820528b61ed9f77)の記事を参照してください）。

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

WORD から  PDF を開く際に、確認メッセージを非表示にするかどうかの情報は、Windows の[レジストリ](https://ja.wikipedia.org/wiki/%E3%83%AC%E3%82%B8%E3%82%B9%E3%83%88%E3%83%AA)に記録されています。
このレジストリを VBA から操作することで、確認メッセージの制御をすることが可能となります。

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

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

このあたりの詳細は「[PDF を WORD に変換してテキストを取得する](https://qiita.com/t-yama-3/items/0b9dc820528b61ed9f77)」という記事に書きましたので、必要に応じて参照してください。

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

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

```vb: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
```

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