ExcelVBAでOutlookメールをPDF化するときに必要なオブジェクトは？

Question

いつもお世話になっております。
今回はExcelVBAを使ってOutlookメールをPDF化する方法について質問があります。

やりたいこと

Outlookメールの中からPDF化したいメールを、あるフォルダに保存します。

その後、ExcelVBAでフォルダの中にあるメールファイルを読み込んでPDF化する、というものです。

そこで何かサンプルとなるコードはないか探したところ、メールをPDF化するのはあまりないようで
なかなか見つかりませんでした。
しかしこういうのがありました。

サンプルコード

Option Explicit
' ここをトリプルクリックでマクロ全体を選択できます。
Public Sub ExportCurrentFolderToPDF()
    Const EXPORT_FOLDER = "C:\作業中\PDF変換テスト" ' 保存先フォルダー
    Const wdExportFormatPDF = 17
    Dim strFileBase As String
    Dim strFileRTF As String
    Dim strFilePDF As String
    Dim appWord As Object 'Word.Application
    Dim fldCurrent As Folder
    Dim objMail As Object 'MailItem
    Dim docRTF As Object 'Word.document
    Dim i As Integer
    strFileBase = Environ("TEMP") & "\msg"
'    strFileBase = "Happy International Women's Day.msg"
    ' Word Application オブジェクトの生成
    Set appWord = CreateObject("Word.Application")
    

'     表示中のフォルダーを取得
    Set fldCurrent = ActiveExplorer.CurrentFolder
    For i = 1 To fldCurrent.Items.Count
        Set objMail = fldCurrent.Items(i)
        If objMail.MessageClass = "IPM.Note" Then

            ' 一時ファイルのファイル名の作成
            strFileRTF = strFileBase & Right("0000" & i, 4) & ".rtf"
            ' 保存先 PDF ファイル名の生成
            strFilePDF = EXPORT_FOLDER & "\msg" & Right("0000" & i, 4) & ".pdf"
            ' メールを RTF ファイルとして保存
            objMail.SaveAs strFileRTF, olRTF
            ' 保存した RTF ファイルを Word で開く
            Set docRTF = appWord.Documents.Open(strFileRTF)
            ' Word で PDF として保存
            docRTF.ExportAsFixedFormat strFilePDF, wdExportFormatPDF
            docRTF.Close
            Set docRTF = Nothing
            ' RTF ファイルの削除
            Kill strFileRTF
        End If
    Next

    ' Word を終了
    appWord.Quit
End Sub

このサンプルでやっていることは、

1. メールボックスのメールを1件ずつ読み込む
2. メールを一旦RTFファイルに変える
3. RTFファイルをWordアプリケーションを通してPDF化

という流れです。
しかし今回は、メールボックスを通さず、メールファイルそのものをPDF化してみたいので
以下のように変更してみました。

変更したコード

Option Explicit
' ここをトリプルクリックでマクロ全体を選択できます。
Public Sub ExportCurrentFolderToPDF()
    Const EXPORT_FOLDER = "C:\作業中\PDF変換テスト" ' 保存先フォルダー
    Const wdExportFormatPDF = 17
    Dim strFileBase As String
    Dim strFileRTF As String
    Dim strFilePDF As String
    Dim appWord As Object 'Word.Application
    Dim fldCurrent As Folder
    Dim objMail As Object 'MailItem
    Dim docRTF As Object 'Word.document
    Dim i As Integer
    strFileBase = Environ("TEMP") & "\msg"
'    strFileBase = "Happy International Women's Day.msg"
    ' Word Application オブジェクトの生成
    Set appWord = CreateObject("Word.Application")
    
    '不要==========================
    ' 表示中のフォルダーを取得
'    Set fldCurrent = ActiveExplorer.CurrentFolder
'    For i = 1 To fldCurrent.Items.Count
'        Set objMail = fldCurrent.Items(i)
'        If objMail.MessageClass = "IPM.Note" Then
     '不要==========================
            ' 一時ファイルのファイル名の作成
            strFileRTF = strFileBase & Right("0000" & i, 4) & ".rtf"
            ' 保存先 PDF ファイル名の生成
            strFilePDF = EXPORT_FOLDER & "\msg" & Right("0000" & i, 4) & ".pdf"
            ' メールを RTF ファイルとして保存
            objMail.SaveAs strFileRTF, olRTF
            ' 保存した RTF ファイルを Word で開く
            Set docRTF = appWord.Documents.Open(strFileRTF)
            ' Word で PDF として保存
            docRTF.ExportAsFixedFormat strFilePDF, wdExportFormatPDF
            docRTF.Close
            Set docRTF = Nothing
        '不要==========================
            ' RTF ファイルの削除
'            Kill strFileRTF
'        End If
'    Next
        '不要==========================
    ' Word を終了
    appWord.Quit
End Sub

分からない点

しかし、以上のコード内にある

' メールを RTF ファイルとして保存
  objMail.SaveAs strFileRTF, olRTF

この「objMail」を別のオブジェクトに置き換えないと、
メールボックスを読み込むことになりエラーになってしまうのですが、
何に置き換えればいいのか分かりません。

どなたか分かる方、ご教示願えますでしょうか？
よろしくお願いいたします。

Answer 1

ご要望の要件だとmsgファイルを開かないといけないので、
Outlook.ApplicationオブジェクトのCreateItemFromTemplateメソッドを使って
MailItemオブジェクトを生成します。

Dim appOlook As Object 'Outlook.Application
Dim objMail As Object 'MailItem
Set appOlook = CreateObject("Outlook.Application")
Set objMail = appOlook.CreateItemFromTemplate(msgファイルフルパス)

とりあえずC:\作業中\tempを読込対象のディレクトリとして、
全てのmsgファイルを変換するならこんな感じでしょうか。

Option Explicit
' ここをトリプルクリックでマクロ全体を選択できます。
Public Sub ExportCurrentFolderToPDF()
    Const EXPORT_FOLDER = "C:\作業中\temp" ' 保存先フォルダー
    Const wdExportFormatPDF = 17
    Dim strFileBase As String
    Dim strFileRTF As String
    Dim strFilePDF As String
    Dim fname As String
    Dim appWord As Object 'Word.Application
    Dim appOlook As Object 'Outlook.Application
    Dim fldCurrent As Folder
    Dim objMail As Object 'MailItem
    Dim docRTF As Object 'Word.document
    Dim i As Integer
    strFileBase = Environ("TEMP") & "\msg"
'    strFileBase = "Happy International Women's Day.msg"
    ' Word Application オブジェクトの生成
    Set appWord = CreateObject("Word.Application")
    Set appOlook = CreateObject("Outlook.Application")
    
    i = 1
    fname = Dir(EXPORT_FOLDER & "*.msg")
    Do While fname <> ""
        ' 一時ファイルのファイル名の作成
        strFileRTF = strFileBase & Right("0000" & i, 4) & ".rtf"
        ' 保存先 PDF ファイル名の生成
        strFilePDF = EXPORT_FOLDER & "\msg" & Right("0000" & i, 4) & ".pdf"
        ' msgファイルを開きMailItemオブジェクトを作成する
        Set objMail = appOlook.CreateItemFromTemplate(EXPORT_FOLDER & "\" & fname)
        ' メールを RTF ファイルとして保存
        objMail.SaveAs strFileRTF, olRTF
        ' 保存した RTF ファイルを Word で開く
        Set docRTF = appWord.Documents.Open(strFileRTF)
        ' Word で PDF として保存
        docRTF.ExportAsFixedFormat strFilePDF, wdExportFormatPDF
        docRTF.Close
        Set docRTF = Nothing
        
        i = i + 1
        fname = Dir()
    Loop

    ' Word を終了
    appWord.Quit
End Sub

Comments

[退会済みユーザー]

そのロジックで無事解決されました。ありがとうございました。