アイテムを PDF としてデスクトップに保存するマクロ


コメントにて以下のご要望をいただきました。


outlookの仕事の効率化に悩んでおり、教えてください。
PC環境は、win10、outlook2016を使用しております。

選択中のメールをPDF保存(保存先はデスクトップ)をしたいと思っており、クイックアクセスツールバーかマクロで1クリック/ショートカットキー操作でできるようにしたいと思っています。
ちなみに、簡単なExcelマクロは記録機能を改良して作る程度はできますが、Outlookマクロは初心者です。

簡単なやり方だとありがたいです。よろしくお願いします!


以前、表示中のフォルダーのメールを PDF でエクスポートするマクロで、メールを RTF として保存し、それを Word で PDF にエクスポートするという方法を紹介しました。
それを応用することで表示中のメールを PDF として保存することが可能です。
マクロは以下のようになりますので、このマクロをクイック アクセス ツールバーに登録してください。

' ここをトリプルクリックでマクロ全体を選択できます。
Public Sub SaveAsPDF()
     Const wdExportFormatPDF = 17
     Dim strFileBase As String
     Dim strFileRTF As String
     Dim strFilePDF As String
     Dim strExportFolder As String
     Dim objFSO As Object 'Scripting.FileSystemObject
     Dim appWord As Object 'Word.Application
     Dim objMail As Object 'MailItem
     Dim docRTF As Object 'Word.document
     Dim c As Integer
     strFileBase = Environ("TEMP") & "\msg"
     strExportFolder = Environ("USERPROFILE") & "\desktop"
     ' Word Application オブジェクトの生成
     Set appWord = CreateObject("Word.Application")
     ' 表示中のアイテムを取得
     If TypeName(ActiveWindow) = "Inspector" Then
         Set objMail = ActiveInspector.CurrentItem
     Else
         Set objMail = ActiveExplorer.Selection(1)
     End If
     ' アイテムがメールだった場合のみ PDF で保存
     If objMail.MessageClass = "IPM.Note" Then
         ' 一時ファイルのファイル名の作成
         strFileRTF = strFileBase & ".rtf"
         ' 保存先 PDF ファイル名の生成
         strFilePDF = strExportFolder & "\msg" & Right("0000" & c, 4) & ".pdf"
         ' ファイルが既に存在する場合は連番を増加
         Set objFSO = CreateObject("Scripting.FileSystemObject")
         While objFSO.FileExists(strFilePDF)
             c = c + 1
             strFilePDF = strExportFolder & "\msg" & Right("0000" & c, 4) & ".pdf"
         Wend
         ' メールを 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
     ' Word を終了
     appWord.Quit
End Sub

マクロの登録方法やメニューへの追加について

コメントを残す

以下に詳細を記入するか、アイコンをクリックしてログインしてください。

WordPress.com ロゴ

WordPress.com アカウントを使ってコメントしています。 ログアウト /  変更 )

Google フォト

Google アカウントを使ってコメントしています。 ログアウト /  変更 )

Twitter 画像

Twitter アカウントを使ってコメントしています。 ログアウト /  変更 )

Facebook の写真

Facebook アカウントを使ってコメントしています。 ログアウト /  変更 )

%s と連携中