コンテキスト メニューでフォルダーの移動を行う Outlook の VSTO アドイン

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


いつも素晴らしいVBA、その他の情報ご提供ありがとうございます。
アイテム右クリックメニューについてお伺いします。かなり以前ですが、「右クリックメニューにフォルダーの移動コマンドを追加するマクロ」を公開いただいておりました。
ここで紹介いただいたApplication_ItemContextMenuDisplay というVBAのイベントは、Web上の情報でサポートされなくなったと聞きました。実際、同マクロは動作しないようです。
現時点で、例えば、特定メールを右クリックしてフォルダに移動する等のコマンドを実行する方法はありますでしょうか? 企業の o365のパッケージ上での Outlook を想定しています


コメントのご指摘の通り、ItemContextMenuDisplay は現在のバージョンでは使用できなくなっています。
現在のバージョンでコンテキスト メニューを拡張するには IRibbonExtensibility オブジェクトを使用してリボンのカスタマイズを行う必要があるのですが、このオブジェクトはマクロでは使用できず、アドインとして実装しなければなりません。
そこで、今回はコンテキスト メニューでフォルダーの移動を行う VSTO アドインの作成方法について説明します。

まず、Outlook の VSTO アドインを作成する方法 に記載されている手順の「アドインのコードの記述」まで実行します。

次にコンテキスト メニューを追加するコードの記述なのですが、その前にメニューを定義した Ribbon XML を作成します。
手順は以下の通りです。

  1. [プロジェクト] の [新しい項目の追加] をクリックする
  2. [新しい項目の追加] で [すべてのテンプレートの表示] をクリックする
  3. [新しい項目の追加 – プロジェクト名] で [リボン (XML)] を選択する
  4. [名前] に適切な名前 (“MyItemMove” など) を入力する
  5. [OK] をクリックする
  6. 右ペインの [ソリューション エクスプローラー] に追加された XML ファイルをダブルクリックする
  7. 既定で追加される XML を以下の XML で置き換える

    <?xml version="1.0" encoding="UTF-8"?>
    <customUI xmlns="http://schemas.microsoft.com/office/2009/07/customui">
      <contextMenus>
        <contextMenu idMso="ContextMenuMailItem">
          <button id="ButtonMoveAAA" label="AAA に移動" onAction="MoveToAAA" />
          <button id="ButtonMoveBBB" label="BBB に移動" onAction="MoveToBBB" />
        </contextMenu>
      </contextMenus>
    </customUI>

上記の XML において、label はボタンに表示されるテキスト、onAction はボタンをクリックすると呼び出されるメソッドを意味します。
メニューを増やす場合は、<button … の行を追加し、idlabelonAction にそれぞれ一意のものを指定します。
そして、呼び出されるメソッドは XML を追加した際に同時に追加された vb (例: MyItemMove.vb) ファイルの Public Class MyItemMove から End Class の間のどこかに以下のように記載します。

' AAA というフォルダーに移動
Public Sub MoveToAAA(ByVal control As Office.IRibbonControl)
    MoveToFolder("AAA")
End Sub
' BBB というフォルダーに移動
Public Sub MoveToBBB(ByVal control As Office.IRibbonControl)
    MoveToFolder("BBB")
End Sub
' 指定した名前のフォルダーに移動
Private Sub MoveToFolder(strFolder As String)
    Dim fldDest As Folder
    Dim objMove As Object
    '
    Try
        With Globals.ThisAddIn.Application
             fldDest = .Session.GetDefaultFolder(OlDefaultFolders.olFolderInbox).Folders(strFolder)
             For Each objMove In .ActiveExplorer.Selection
                 objMove.Move(fldDest)
            Next
         End With
     Catch ex As System.Exception

    End Try
End Sub

今回は、アイテムを移動するという共通処理を MoveToFolder というメソッドとして実装し、メニューから呼び出されるメソッド内でフォルダー名を指定して呼び出す形にしました。
ちなみに、Outlook の Application オブジェクトを VSTO アドインで使用する場合、ThisAddin.vb の中であれば Me.Application として参照可能ですが、それ以外のモジュールから参照する場合は Globals.ThisAddin.Application とします。

最後に、このコンテキスト メニューを使用できるように、既定で追加される ThisAddin.vb の中の Public Class ThisAddIn から End Class の間のどこかに以下の記述を追加します。

Protected Overrides Function CreateRibbonExtensibilityObject() As Microsoft.Office.Core.IRibbonExtensibility
     Return New MyItemMove()
End Function

今回の例ではリボン XML の追加の際に MyItemMove という名前を付けたので、Return New MyItemMove() となっていますが、他の名前を付けた場合は Return New リボン名() というコードになります。

この後は、Outlook の VSTO アドインを作成する方法 に記載されている手順のアドインのビルド以降を実行して完成です。

Outlook の VSTO アドインを作成する方法

これまで、様々なマクロを公開し、多くの方に使っていただいているようです。
ただ、Outlook のマクロは異なる端末に配布して使うという方法がサポートされていないため、複数のユーザーで同じマクロを使いたい場合にはそれぞれの端末に手作業でコピーする必要があります。
また、マクロを更新したような場合は、それぞれの端末で改めてコピーしなおさなければならないこともあります。

これを回避するにはマクロの内容を VSTO アドインとして実装し、展開する必要があります。
アドインの開発となると敷居が高いように感じるかもしれませんが、Visual Studio で VSTO アドインを作る場合、実はそれほど難しくありません。
特に、言語として Visual Basic を使えば、マクロのコードをちょっと変更するだけでアドインとして実装できる場合もあります。

今回は遅延配信を行うマクロを例にして、VSTO アドインの開発について説明しましょう。

Visual Studio 2022 Community Edition のダウンロードとインストール

VSTO アドインの開発には Visual Studio 製品が必要となります。
個人あるいは小規模の組織であれば、無償で Community エディションを使用することが可能ですので、今回は最新の Visual Studio 2022 Community Edition を使って説明します。
ダウンロードは以下のページから可能です。

Visual Studio 2022 コミュニティ エディション – 最新の無料バージョンをダウンロードする (microsoft.com)

このページの [ダウンロード] というボタンをクリックすると VisualStudioSetup.exe というファイルがダウンロードされるので、これを実行してインストールを開始します。
インストール画面でインストールするコンポーネントの選択がありますが、ここでは [Office/SharePoint 開発] をオンにして [インストール] をクリックします。

あとはしばらく待てばインストールは完了です。

新しいプロジェクトの作成

インストールが完了したら、VSTO アドインのためのプロジェクトを作成します。
手順は以下の通りです。

  1. Visual Studio 2022 を起動する
  2. [新しいプロジェクトの作成] をクリックする
  3. 右ペインからアイコンの右上に VB と書かれている [Outlook VSTO アドイン] ([Outlook Web アドイン] ではないので注意) をクリックし、[次へ] をクリックする
  4. プロジェクト名に適切な名前 (今回の場合は “DeferredSend” など) を入力し、[フレームワーク] を選択して [作成] をクリックする

これにより、ThisAddIn_Startup と ThisAddIn_Shutdown という二つのイベントが追加済みのプロジェクトが作成されます。

なお、フレームワークは VSTO アドインが動作する .NET Framework のバージョンの指定です。
既定でも問題はないと思いますが、古い環境などがあり最新の .NET Framework が使えないという場合、古いバージョンを選択する必要があるかもしれません。

アドインのコードの記述

起動時にアドインで処理が必要なら、ThisAddIn_StartUp イベントに記述することになります。

これ以外のイベント、例えば NewMailEx や ItemSend イベントを追加したい場合、コードエディタ上部の 3 つのドロップダウンのうち、中央のドロップダウンで Application を選択してから、右のドロップダウンでイベントを選択します。
今回はメール送信時の処理を追加するので、ItemSend を選択します。

すると、以下のようなコードが追加されます。

    Private Sub Application_ItemSend(Item As Object, ByRef Cancel As Boolean) Handles Application.ItemSend

    End Sub

送信時に遅延配信を設定する場合、Item として渡された MailItem の DeferredDeliveryTime に遅延配信したい時刻を設定します。
例えば、1 分遅延させたければ DateAdd 関数で現在時刻に 1 分追加した時刻を DeferredDeliveryTime に設定するということになります。

ただし、Item には MailItem だけでなく MeetingItem などのオブジェクトが格納される場合もあるため、Item 自体は Object 型の変数として定義されています。
これを MailItem として使うために別途 MailItem 型の変数を定義し、その変数に Item を代入して使用します。

また、その際に MailItem 以外のオブジェクトが格納されていた場合は例外が発生するので、例外発生によりアドインが無効化されないよう、Try Catch 構文を使用します。
上記を踏まえ、遅延配信をするように ItemSend にコードを追加すると以下のようになります。

    Private Sub Application_ItemSend(Item As Object, ByRef Cancel As Boolean) Handles Application.ItemSend
         Const DEFERRED_MIN = 1
         Dim mlItem As MailItem
         '
         Try
             mlItem = Item
             mlItem.DeferredDeliveryTime = DateAdd("n", DEFERRED_MIN, Now)
         Catch ex As System.Exception

         End Try
     End Sub

今回は、コードの記述はこれだけです。

アドインのビルド

ビルドとはアドインを実行するための DLL を生成する作業です。
コードの記述が完了したら、[ビルド]-[ソリューションのビルド] でアドインをビルドします。
エラーが発生したらコードを見直してみてください。
例えば、Try と入力して自動的に挿入される Catch ex As Exception をそのままにしておくとエラーとなります。
これは、Outlook オブジェクト モデルに含まれる Exception というクラスが .NET Framework の System.Exception と競合するためです。
明示的に Catch ex As System.Exception と記載することでエラーを回避できます。

アドインのデバッグ

作成したアドインが正常に動作するかを確認するため、Visual Studio を使ってデバッグ実行してみましょう。
[プロジェクト]-[プロジェクト名 のデバッグ] をクリックし、[デバッグ] タブの [開始動作] で [外部プログラムの開始] を選択して、[参照] により Office がインストールされているフォルダーから Outlook.exe を選択します。
インストール形態にもよりますが、以下のいずれかになるでしょう。

C:\Program Files\Microsoft Office\root\Office16\OUTLOOK.EXE
C:\Program Files (x86)\Microsoft Office\root\Office16\OUTLOOK.EXE
C:\Program Files\Microsoft Office\Office16\OUTLOOK.EXE
C:\Program Files (x86)\Microsoft Office\Office16\OUTLOOK.EXE

そして、Outlook が終了した状態で F5 キーを押すと、作成したアドインを読み込んで Outlook が起動します。
この状態でメールを送信し、1 分遅延して送信されれば、アドインが正常に動作したと判断できます。

アドインの展開

アドインが完成したら、他の PC にも展開するための作業を行います。
具体的には DLL をインストールしてアドインとして登録する Setup.exe を作成するということです。

といっても、実際には右ペインに表示されている [ソリューション エクスプローラー] の中のプロジェクト名のアイコンを右クリックし、[発行] をクリックするだけです。
アプリケーションを公開する場所に Setup.exe を作成するフォルダー パスを指定して [完了] をクリックすると、そのフォルダーに Setup.exe とインストールに必要な様々なファイルが生成されます。
このフォルダーをファイル サーバーや USB メモリなどで共有し、Setup.exe を実行することで、アドインがインストールできます。

さらに、この Setup.exe による公開方法は ClickOnce と呼ばれるもので、アドインを更新した際に再度インストールをしなくてもクライアント側で自動的に更新できるという機能があります。
例えば、組織内のファイル サーバーにアドインのセットアップ ファイルを発行している場合、更新バージョンを発行すると Outlook が起動時にインストール元のファイル サーバー上のファイル バージョンを確認し、更新されていたら新しいバージョンを自動的にインストールするのです。

以上で、VSTO アドインの作成は完了です。

新しい Outlook for Windows で MSG ファイルや EML ファイルを開く方法

Office 製品の Outlook では msg ファイルや eml ファイルを開くことができましたが、新しい Outlook for Windows をインストールしても、msg ファイルや eml ファイルに関連付けられたアプリとして表示されません。

そのため、これらのファイルをダブルクリックにより新しい Outlook for Windows で開くことはできないのですが、一手間かけることで開くことができます。
手順は以下の通りです。

  1. [新規メール] をクリックし、新しいメールを作成する
  2. msg/eml ファイルをメールの本文にドラッグし、[ファイルを添付] にドロップする
  3. 添付した msg/eml ファイルをダブルクリックする

そのうちこのようなことをしなくても開けるようになると思いますが、それまではこれで対処できますね。

Outlook の Copilot と新しい Outlook for Windows

いろいろと話題になっている Microsoft 365 の AI を使用した Copilot が 11 月 1 日から企業向けに提供され始めました。
Outlook の Copilot も提供されましたが、現時点では新しい Outlook for Windows (以下 New Outlook) と Outlook on the Web で使用可能なものの、Microsoft 365 Apps の Outlook (以下 Classic Outlook) では使用できません。

そのため、これを機会に New Outlook に切り替えようと思われる方もいるかもしれません。
しかし、New Outlook を組織で使う場合、以下のような点に注意が必要です。

1. 有償サポートがない

New Outlook はコンシューマー向けとしては正式公開となっていますが、企業向けとしてはまだプレビューのままであり、有償サポート窓口ではサポートが受け付けられません。
今のところ、何か問題が発生したら New Outlook の [ヘルプ]-[サポート]-[サポートへの問い合わせ] から問い合わせするしかない状況です。

2. COM/VSTO アドインが使用できない

New Outlook では COM アドイン (VSTO アドイン) が使用できません。
社内で誤送信防止やウイルススキャン、添付ファイルの暗号化などのために COM アドインを使用をしている場合、それらが使えなくなることになります。
なお、New Outlook で COM アドインがサポートされる予定はありません。

3. マクロや Outlook Object Model が使用できない

Outlook のマクロは COM アドインとして実装されていますので、COM アドインが使えないということはマクロも使用できません。
また、Outlook Object Model の提供もされていないので、他の Office アドインからマクロで Outlook を呼び出すと、New Outlook ではなく Classic Outlook が起動されることになります。

4. クライアント ルールが使用できない

New Outlook では クライアント ルールは使用できません。
そのため、クライアント ルールでなければ実装できないような条件やアクションは設定できません。
なお、送信ルールはすべてクライアント ルールとなるため、New Outlook では遅延配信などを含む送信ルールが一切使えないことになります。

5. PST が使用できない

現時点では、New Outlook は PST をサポートしていません。
新しい Outlook for Windows の概要 ではもうすぐリリースされるとあるのですが、今のところロードマップに具体的なリリース予定は掲載されていません。

6. グループポリシーが使用できない

Classic Outlook ではグループポリシーを使用して細かい制御 (特定機能の無効化や特定の設定の強制など) ができましたが、New Outlook ではグループポリシーの設定がありません。
Exchange Online 側で制御できる Outlook on the Web の設定については New Outlook でも有効ですが、それ以外のことはほとんどできません。

7. カスタム フォームが使用できない

最近はほとんど使われていないかもしれませんが、Classic Outlook にはカスタム フォームといってメールや予定アイテムの UI をユーザーが作り変える機能があります。
これを使用しているような場合、New Outlook では使えなくなります。

8. RSS フィードや SharePoint 同期が使用できない

これも使用されている人は少数派かもしれませんが、RSS フィードや SharePoint との同期なども使用できません。
SharePoint で連絡先や予定表を作成してチームで共有しているというような場合、Outlook でアドレス帳として使用したり、自分の予定表と SharePoint の予定表を重ねて表示するというようなことができなくなります。

上記以外にも細かな違いは多々あり、New Outlook を Classic Outlook の新しいバージョンと思って使用すると大混乱に陥る可能性があります。
もし、Copilot を使用したいというだけで New Outlook にしようと考えているのであれば、来年の 3 月に予定されている Classic Outlook 向けの Copilot の提供を待ったほうが良いでしょう。

自動仕分けルールによりメール本文のデータを Excel ファイルに保存するマクロ

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


いつも参考にさせていただいております。
決まった件名のメッセージを受信したら、データを Excel ファイルに保存するマクロ (複数行対応バージョン)】の記事を拝見し、マクロがうまく流れたので、アレンジさせていただこうと思っておりましたが、以下前提だとうまく使いこなせませんでした。
以下前提でアドバイスいただけないでしょうか。

目的:グループメールアドレスに送られてきた場合、そこに含まれる本文をエクセルに自動追記したい(件名ではなく、受信メールアドレスをキーにエクセル転記を行いたい)

上記マクロからの変更点:
1.AUTO_SAVE_TITLE = ”タイトル” → AUTO_SAVE_ADRESS = ”xxx@xxx” (←宛先に含まれている予定のグループアドレスを指定)
2.If myMsg.subject = AUTO_SAVE_TITLE then  → If myMsg.to = AUTO_SAVE_ADRESS then  (.toを使用し受信者アドレスを検索)

結果として.subjectの場合はマクロが動くのですが、.toの場合は動きません。
何が悪いのかわからずアドバイスいただけますと幸いです。


MailItem の To プロパティはあて先全体の表示名とアドレスを含む文字列となるので、アドレスを含むという場合には以下の通り記載する必要があります。

If Instr(myMsg.To, AUTO_SAVE_ADDRESS) > 0 Then

ただし、Exchange サーバー環境においては組織内の受信者については To プロパティに表示名のみが含まれるので、上記の記述でも正しく認識できません。
そのため、マクロで判定するとなると Recipients オブジェクトからアドレスを取得し、場合によっては SMTP アドレスに変換するなどの処理が必要となるので、いささか面倒です。

そこで、受信したアドレスごとに異なる条件で受信メールをマクロにより MSG ファイルとして保存する方法で説明したように、条件判定は自動仕分けルールに任せてしまうという手があります。
この記事では元のマクロがルールで呼び出せる形になっていましたが、今回の Excel ファイルへの保存マクロはそのままではルールに使用できないので、Exchange/Office 365/Outlook.com 環境で NewMailEx が動作しない場合があるで記載したような書き換えが必要になります。

具体的には以下のようなマクロに変更し、ルールのスクリプトとして SaveToExcelByRule を呼び出します。

'
Public Sub SaveToExcelByRule(ByRef myMsg As MailItem)
     Const EXCEL_FILE = "c:\temp\request.xlsx" ' 保存する Excel ファイルの名前
     Dim i As Integer
     Dim objBook
     Dim objSheet
     Dim r As Integer
     Dim arrColumn As Variant
     Dim iCur As Integer
     Dim iNext As Integer
     ' Excel ファイルを開く
     Set objBook = GetObject(EXCEL_FILE)
     objBook.Windows(1).Activate
     Set objSheet = objBook.Sheets(1)
     ' 1 行目はタイトルとして使用し、2 行目からデータ
     r = 2
     ' データがない行まで移動
     While objSheet.Cells(r, 1) <> ""
         r = r + 1
     Wend
     ' 取得する情報のキーワードを定義
     arrColumn = Array("・番号", "・氏名", "・住所", "・生年月日", "・依頼内容")
     iCur = 1
     ' 最初のキーワードまで移動
     GetValueToToken myMsg.Body, arrColumn(0), iCur
     For i = 1 To UBound(arrColumn)
         ' 次のキーワードまでの文字列を習得して Excel に転記
         objSheet.Cells(r, i) = GetValueToToken(myMsg.Body, arrColumn(i), iCur)
     Next
     ' 最後のキーワードのデータは本文の最後までを取得
     objSheet.Cells(r, i) = TrimCrLf(Mid(myMsg.Body, iCur))
     ' Excel ファイルを閉じる
     objBook.Close True
End Sub
' 次のキーワードまでの文字列を取得する関数
Private Function GetValueToToken(strBody As String, strToken As Variant, iPtr As Integer) As String
     Dim iNext As Integer
     Dim strValue As String
     ' 次のキーワードまでの文字位置を取得
     iNext = InStr(iPtr, strBody, strToken)
     If iNext > 0 Then
         ' 現在の位置から次のキーワードまでの文字列を取得
         strValue = Mid(strBody, iPtr, iNext - iPtr)
         GetValueToToken = TrimCrLf(strValue)
         ' 現在の位置をキーワードの終わりまで移動
         iPtr = iNext + Len(strToken)
     Else
         GetValueToToken = ""
     End If
End Function
' 文字列の前後の余計な改行を削除する関数
Private Function TrimCrLf(strValue As String) As String
     While Left(strValue, 1) = vbCr Or Left(strValue, 1) = vbLf
         strValue = Right(strValue, Len(strValue) - 1)
     Wend
     While Right(strValue, 1) = vbCr Or Right(strValue, 1) = vbLf
         strValue = Left(strValue, Len(strValue) - 1)
     Wend
     TrimCrLf = strValue
End Function

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

未返信のメールを別のフォルダーに移動するマクロ

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


いつも参考にさせていただいています。

特定のフォルダにある未返信のメールをリストアップ、もしくは、所定のフォルダに移動させたいのです。VBAで実現する方法をアドバイスをいただければ幸いです。


メールが返信済みの場合、以下のようにプロパティが設定されます。

  • PR_ICON_INDEX (メッセージ一覧で表示するアイコンの指定) が 261 (返信アイコン) に変わる
  • PR_LAST_VERB_EXECUTED (メッセージに対して最後に実行された処理) が 102 (差出人に返信) または 103 (全員に返信) に変わる

そのため、この二つのプロパティをチェックして未返信かどうかの判断が可能です。
ただし、返信した後で同じメールを転送したような場合、上記のプロパティは転送を意味する値に上書きされます。
そのような状況でも返信済みかどうかを判断することは残念ながら困難です。

未返信のメールを別のフォルダーに移動するマクロは以下のようになります。

'
Public Sub MoveUnrepliedItems()
     Const PR_ICON_INDEX = "http:" & "//schemas.microsoft.com/mapi/proptag/0x10800003"
     Const PR_LAST_VERB_EXECUTED = "http:" & "//schemas.microsoft.com/mapi/proptag/0x10810003"
     Const ICON_REPLY = 261
     Const VERB_REPLYTOSENDER = 102
     Const VERB_REPLYALL = 103
     Const SRC_FOLDER = "処理前"
     Const DST_FOLDER = "未返信"
     '
     Dim fldInbox As Folder
     Dim fldSrc As Folder
     Dim fldDst As Folder
     Dim i As Integer
     Dim iIndex As Integer
     Dim iLastV As Integer
     '
     Set fldInbox = Session.GetDefaultFolder(olFolderInbox)
     Set fldSrc = fldInbox.Folders(SRC_FOLDER)
     Set fldDst = fldInbox.Folders(DST_FOLDER)
     '
     For i = fldSrc.Items.Count To 1 Step -1
         With fldSrc.Items(i).PropertyAccessor
             iIndex = .GetProperty(PR_ICON_INDEX)
             iLastV = .GetProperty(PR_LAST_VERB_EXECUTED)
         End With
         If iIndex = ICON_REPLY Or iLastV = VERB_REPLYTOSENDER Or iLastV = VERB_REPLYALL Then
             '
         Else
             fldSrc.Items(i).Move fldDst
         End If
     Next
End Sub

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

受信したアドレスごとに異なる条件で受信メールをマクロにより MSG ファイルとして保存する方法

受信したメールを自動的に MSG ファイルとして保存するマクロのコメントにて以下のご要望をいただきました。


いつも参考にさせていただいています。

複数のアドレス(5つほど)を受信しているのですが、アドレスごとに条件を設定することは可能でしょうか?
1@O.com は test と入っている場合保存、2@O.com はfile と入っている場合保存など設定したいと考えています。


複数のアドレスで受信しているということなのですが、複数アドレスで受信する構成としては以下のいずれかが考えられます。

  • Outlook に複数のアカウントを登録している
  • Outlook に登録している一つのアカウントが複数のアドレスを受信する (Outlook.com や Gmail.com のエイリアス)

どちらの構成なのかによりマクロの内容が異なりますし、他の条件と組み合わせるとマクロが複雑になります。

しかし、自動仕分けにより条件を指定し、保存するマクロをルールの処理で指定すれば、条件の指定について柔軟な対応が可能になります。
例えば、アカウントとして 1@O.com2@O.com を追加している場合、以下のような二つのルールを作ることで対応可能です。

– ルール 1
1@O.com アカウントを経由した場合
  さらに [件名] に test が含まれる場合
  さらにこのコンピューターで送受信を行った場合のみ
Project1.ThisOutlookSession.SaveAsMsg を実行する

– ルール 2

2@O.com アカウントを経由した場合
  さらに [件名] に file が含まれる場合
  さらにこのコンピューターで送受信を行った場合のみ
Project1.ThisOutlookSession.SaveAsMsg を実行する

一方、受信したアドレスをもとに保存するという場合は、以下のようなルールとなります。

– ルール 1

[宛先] または [CC] が 1@O.com の場合

  さらに [件名] に test が含まれる場合

  さらにこのコンピューターで送受信を行った場合のみ

Project1.ThisOutlookSession.SaveAsMsg を実行する

– ルール 2

[宛先] または [CC] が 2@O.com の場合

  さらに [件名] に file が含まれる場合

  さらにこのコンピューターで送受信を行った場合のみ

Project1.ThisOutlookSession.SaveAsMsg を実行する

これで、アドレスや件名などの条件が変わった場合でも、マクロを変更することなく対応ができます。

なお、マクロを自動仕分けの処理として指定するためには以下のレジストリ設定が必要です。

キー: HKEY_CURRENT_USER\Software\Microsoft\Office\16.0\Outlook\Security\

値の名前: EnableUnsafeClientMailRules

値の種類: REG_DWORD

値のデータ: 1

念のため、元のブログの SaveAsMsg マクロを再掲します。

'
Public Sub SaveAsMsg(ByRef objMsg As MailItem)
    ' ファイルを保存するフォルダーを指定。最後に \ が必要
    Const SAVE_PATH = "C:\temp\"
    Dim objFSO As Object ' FileSystemObject
    Dim strSubject As String
    Dim strFileBase As String
    Dim strFileName As String
    Dim i As Integer
    Dim ch As String
    Dim c As Integer
    '
    Set objFSO = CreateObject("Scripting.FileSystemObject")
'
' ここで条件指定
' 例えば、test という文字列を件名に含むものだけ保存する場合、
' 「test を件名に含まない場合に Exit Sub」というコードにする
'
'  If Not (objMsg.Subject Like "*test*") Then Exit Sub
'
    ' 件名をファイル名にする
    strSubject = objMsg.Subject
    ' 件名の前に受信日時をつける場合は以下を使用
    ' strSubject = objMsg.ReceivedTime & " " & objMsg.Subject
    ' 件名の前に差出人をつける場合は以下を使用
    ' strSubject = objMsg.SenderName & " " & objMsg.Subject
    ' ファイル名に使用できない文字を _ に置き換える
    strFileBase = ""
    For i = 1 To Len(strSubject)
        ch = Mid(strSubject, i, 1)
        If InStr("\/:*?""|", ch) > 0 Then
            ch = "_"
        End If
        strFileBase = strFileBase & ch
    Next
    '
    strFileName = SAVE_PATH & strFileBase & ".msg"
    '
    c = 1
    ' 同名のファイルが存在したら
    While objFSO.FileExists(strFileName)
        ' ファイル名に -連番 をつける
        strFileName = SAVE_PATH & strFileBase & "-" & c & ".msg"
        c = c + 1
    Wend
    ' MSG ファイルとして保存する
    objMsg.SaveAs strFileName, olMSG
    Set objFSO = Nothing
End Sub

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

定期的な予定の特定の日の回だけ削除するマクロ

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


定期的な予定(終日)の1つ(特定の日付を指定)を削除しようとしているのですが、Restrict でアイテムを抽出して、そのアイテムを delete で削除したら、定期的なアイテム全体が削除されてしまいました。
特定の1つだけ削除する方法を教えてください。


定期的な予定を展開して削除を行う場合、Items コレクションの IncludeRecurrence プロパティを True にしてから日付範囲の検索を行って削除します。
削除する回の日付と件名を指定して定期的な予定のうちの一つを削除するマクロは以下の様になります。

'
Public Sub RemoveOneAppt(strDate As String, strSubject As String)
     Dim fldCal As Folder
     Dim colItems As Items
     Dim strStart As String
     Dim strEnd As String
     Dim oneAppt As AppointmentItem
     '
     Set fldCal = Session.GetDefaultFolder(olFolderCalendar)
     Set colItems = fldCal.Items
     colItems.Sort "開始日"
     colItems.IncludeRecurrences = True
     '
     strStart = FormatDateTime(strDate, vbShortDate)
     strEnd = FormatDateTime(DateAdd("d", 1, strDate), vbShortDate)
     '
     Set oneAppt = colItems.Find("[開始日] <= """ & strEnd & _
         """ And [終了日] >= """ & strStart & """")
     While TypeName(oneAppt) <> "Nothing"
         If oneAppt.Subject = strSubject Then
             oneAppt.Delete
         End If
         Set oneAppt = colItems.FindNext
     Wend
End Sub

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

Outlook の [ショートカット] モジュールにある [Microsoft Office Online] をクリックするとスクリプト エラーになる

Outlook のナビゲーション ウィンドウには [ショートカット] というモジュールがあり、そこに追加したリンクを Outlook 内のブラウザで表示させることができます。
しかし、このショートカットに既定で追加されている [Microsoft Office Online] をクリックすると、スクリプト エラーが多発します。
これは、Outlook 内のブラウザが Internet Explorer のコンポーネントを使用しているために発生しています。

[Microsoft Office Online] をクリックすると Microsoft 365 の紹介ページが開かれますが、Microsoft 365 のサイトは Internet Explorer をサポートしていません。
そのため、Internet Explorer で使用できない JavaScript の記述が多用されており、様々なスクリプト エラーが表示されることになるのです。

残念ながら Outlook が使用する Web ブラウザのコンポーネントを変更することはできないため、回避策としては [Microsoft Office Online] を削除するというものが考えられます。
ただ、多数のユーザーがいる組織で個々のユーザーに手動で [Microsoft Office Online] のリンクを削除してもらうというのは現実的ではないでしょう。
そこで他の対処方法としては、以下のレジストリを展開するというものがあります。

キー: HKEY_CURRENT_USER\SOFTWARE\Microsoft\Office\16.0\Outlook\Preferences
名前: ModuleVisible15
種類: REG_DWORD
値: 1,1,1,1,1,1,0,1,0

このレジストリはナビゲーション ウィンドウに表示されるモジュールの表示・非表示を設定するもので、左から 7 番目が [ショートカット] に相当します。
そこで、7 番目の数字を 0 として設定することで、[ショートカット] 自体を非表示にしてしまうのです。
[ショートカット] 機能が使えなくなるということにはなりますが、最近は Internet Explorer に対応していない Web サイトも増えてきており、[ショートカット] がなくてもほとんど支障はないと考えられます。

なお、0 にする個所を間違えると、他のモジュールが使用できなくなるのでご注意ください。

参考:

ショートカット関数から [Microsoft Office Online] をクリックすると Outlook でスクリプト エラーが発生する – Microsoft サポート

予定表機能を利用しないよう制御する方法 (microsoft.com)

連絡先フォルダーのすべての連絡先アイテムを vCard ファイルとして保存するマクロ

Outlook の連絡先情報を他のアプリケーションで取り込む方法としては以下の2つがあります。

・CSV ファイルでエクスポートする

・vCard (vcf) ファイルでエクスポートする

このうち、CSV については複数の連絡先をまとめてエクスポート可能ですが、vCard についてはアイテムを一つずつ開き、[名前を付けて保存] により vCard 形式で保存する必要があります。
このような同じ処理を繰り返す場合こそ、マクロの出番です。
以下は連絡先フォルダーのすべての連絡先アイテムを vCard ファイルとして保存するマクロになります。

'
Public Sub ExportAllContactsToVCF()
     ' 出力先のフォルダーを指定
     Const EXPORT_PATH = "c:\export\"
     Dim fldContact As Folder
     Dim oneContact As Object ' ContactItem
     Dim strFileName As String
     ' 既定の連絡先フォルダーを取得
     Set fldContact = Session.GetDefaultFolder(olFolderContacts)
     ' 現在表示しているフォルダーをエクスポートする場合は以下の記述を使用
     ' Set fldContact = ActiveExplorer.CurrentFolder
     For Each oneContact In fldContact.Items
         ' 連絡先アイテムのみエクスポート (グループはエクスポート不可)
         If TypeName(oneContact) = "ContactItem" Then
             With oneContact
                 strFileName = ReplaceSpecialChar(.Subject & ".vcf")
                 strFileName = MakeUniqueFileName(EXPORT_PATH, strFileName)
                 .SaveAs strFileName, olVCard
             End With
         End If
     Next
End Sub
' ファイルやフォルダーに使用できない文字列の削除
Private Function ReplaceSpecialChar(strSubject As String) As String
     ReplaceSpecialChar = ""
     For i = 1 To Len(strSubject)
         ch = Mid(strSubject, i, 1)
         If InStr("\/:*?""|", ch) > 0 Then
             ch = "_"
         End If
         ReplaceSpecialChar = ReplaceSpecialChar & ch
     Next
End Function
' 重複しないファイル名を生成する関数
Private Function MakeUniqueFileName(strPath As String, strFileName As String)
     Dim strFileBase As String
     Dim strExt As String
     Dim iExt As Integer
     Dim c As Integer
     '
     iExt = InStrRev(strFileName, ".")
     If iExt > 0 Then
         strFileBase = Left(strFileName, iExt - 1)
         strExt = Mid(strFileName, iExt)
     Else
         strFileBase = strFileName
         strExt = ".dat"
         strFileName = strFileName & strExt
     End If
     '
     c = 1
     While Dir(strPath & "\" & strFileName) <> ""
         strFileName = strFileBase & "[" & c & "]" & strExt
         c = c + 1
     Wend
     MakeUniqueFileName = strPath & "\" & strFileName
End Function

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