【OutlookVBA】メールの「名前を付けて保存」の効率化パターン①
【本記事の対象者】
・メーラーがOutlookである。
・事務の中に「メールの保存」があり、面倒だと思っている。
・VBA開発ができる(許される)環境にある。
【本記事を読んだ結果できること】
・メールの「名前をつけて保存」が効率化できる。
【前提】
私は「Outlook研究所(https://outlooklab.wordpress.com/)」様を見てVBAの勉強をしました。
OutlookでVBA(マクロ)を使うのが初めてで、設定をしたこともないという方は、
Outlook VBA マクロ、はじめの一歩 | Outlook 研究所の記事が参考になるかと思います。
特に、セキュリティに関することの設定や、クイックアクセスツールバーにマクロ実行用ボタンを用意することへの理解は必須になります。
なお、私は事務員でありSEではありません。
専門的な質問への回答はできませんので、ご承知ください。
メールの保存、面倒ですよね。
メールの保存を効率化したマクロを開発しましたので、ご利用いただければと思います。
なお、「こんな機能があればもっと便利」等があれば作成にチャレンジしたいので、コメントいただきたいです。
処理の流れは、以下の画像のようになります。
①保存したいメールをOutlook上で選択する。
②あらかじめツールバーに作成しておいたマクロ実行用のボタンを押す
③保存場所を選択する画面が現れるので、選択してOKをクリックする。
(プログラムの都合上Excelが起動します)
④メールを保存するためのフォルダを作成するので、フォルダ名を決めます。
⑤フォルダが作成されます。メール本文はtxtで保存されて、添付ファイルがある場合には添付ファイルも保存されます。
⑥保存が完了した旨のダイアログが出ます。
コードは以下のとおりです。
クイックアクセスツールバーにマクロ実行用のボタンを作成して
使っていただくと便利かと思います。
Sub メールを今から選ぶ場所に保存() Dim appExcel As Object Set appExcel = CreateObject("Excel.Application") 'ダイアログを表示して保存場所を決める Dim strSavePathName As String appExcel.Visible = True AppActivate ("Excel") appExcel.WindowState = 2 appExcel.WindowState = 1 With appExcel.FileDialog(msoFileDialogFolderPicker) If .Show = 0 Then appExcel.Visible = False 'Excelを消す Exit Sub End If strSavePathName = .SelectedItems(1) appExcel.Visible = False 'Excelを消す End With 'メールのセット Dim objItem As Object If TypeName(Application.ActiveWindow) = "Inspector" Then Set objItem = Application.ActiveInspector.CurrentItem Else Set objItem = ActiveExplorer.Selection(1) End If '「strSubject」にメールの件名をセットし、 '不正なファイル名の原因となる文字をReplace Dim strSubject As String strSubject = objItem.Subject strSubject = Replace(strSubject, " ", "") strSubject = Replace(strSubject, ":", ":") strSubject = Replace(strSubject, "\", "¥") strSubject = Replace(strSubject, "/", "/") strSubject = Replace(strSubject, "|", "|") strSubject = Replace(strSubject, "<", "<") strSubject = Replace(strSubject, ">", ">") strSubject = Replace(strSubject, "?", "?") strSubject = Replace(strSubject, "*", "*") '保存の際につけたいフォルダ名は場合によって違うので、 'Inputboxから設定する。 'デフォルトでメールの件名を表示する。 'ダイアログで指定されたフォルダに、インプットボックスで指定された '名前のフォルダを作成して、メールの保存処理。 Dim strSaveFolderName As String strSaveFolderName = InputBox("フォルダ名を入力してください。" _ & vbCrLf & "ここに入力した文字列がフォルダ名になります。", _ Default:="" & strSubject & "") If strSaveFolderName = "" Then 'キャンセルされた時用。 Exit Sub End If '同じメールが保存されてないかチェック '(正確には、同じフォルダが作成されていないかチェック) 'あった場合は処理終了 strSavePathName = "" & strSavePathName & "\" & strSaveFolderName & "" If Dir(strSavePathName, vbDirectory) = "" Then MkDir strSavePathName Else MsgBox ("同じタイトルのメールが既に保存されています。" _ & vbCrLf & "確認してください。") End End If 'txtとして保存。「oltxt」は書かないと文字化けするみたい。 objItem.SaveAs strSavePathName & "\" & strSubject & ".txt", olTXT '添付ファイルの保存処理 Dim objAttachment As Object Dim strAttachSavePath As String With objItem For Each objAttachment In .Attachments strAttachSavePath = strSavePathName & "\" & objAttachment objAttachment.SaveAsFile strAttachSavePath Next objAttachment End With MsgBox ("保存が完了しました。") End Sub
以上です。
このコード中では、「フォルダ作成+本文txt+添付ファイル保存」でメールを保存しています。
しかし、msg形式でメールを保存している方もいるかと思います。
その場合は、「save as」の部分をいじっていただくことになります。
この記事が事務処理効率向上に寄与すれば幸いです。
またパターン②も書きます。