場所から自動的に会議室メールボックスを宛先に追加するマクロ

Exchange サーバー環境では会議室のためのメールボックスを作り、会議出席依頼で会議室の予約を行うことができます。
また、会議室のメールボックスをリソースとして宛先に追加すると、同時に会議アイテムの [場所] にその会議室が設定されます。
この機能は非常に便利なのですが、ちょっと厄介なのが [場所] の履歴に会議室が残るという点です。
[場所] フィールドの右にはドロップダウンがあり、過去に使用した場所を選択することができるのですが、以前送信した会議室のメールボックスを指定しても宛先には自動では含まれません。
そのため、[場所] で会議室を選択した後、改めて会議室をリソースとして宛先に追加しなおす必要があるのです。
この操作を忘れて会議室を予約し忘れるということが発生しがちなので、場所に設定した会議室を宛先に追加し忘れていた場合に、自動で設定するマクロを作ってみました。
以下のようなマクロで実現できます。

' ここをトリプルクリックでマクロ全体を選択できます。
Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
    If TypeName(Item) = "MeetingItem" Then
        ReplaceLocationToResource Item
    End If
End Sub
'
Private Sub ReplaceLocationToResource(ByVal meetItem As MeetingItem)
    Const PR_DISPLAY_TYPE_EX = "http://schemas.microsoft.com/mapi/proptag/0x39050003"
    Const DT_ROOM = 7
    Dim apptItem As AppointmentItem
    Dim resRecip As Recipient
    Dim bDelete As Boolean
    '
    Set apptItem = meetItem.GetAssociatedAppointment(False)
    If InStr(apptItem.Resources, apptItem.Location) > 0 Then
        Exit Sub    ' すでにリソースに登録済みなら終了
    End If
    Set resRecip = meetItem.Recipients.Add("=" & apptItem.Location)
    bDelete = True
    resRecip.Resolve
    If resRecip.Resolved Then
        If resRecip.AddressEntry.Type = "EX" Then
            If resRecip.AddressEntry.AddressEntryUserType = olExchangeUserAddressEntry Then
                Dim exchUser As ExchangeUser
                Set exchUser = resRecip.AddressEntry.GetExchangeUser
                If exchUser.PropertyAccessor.GetProperty(PR_DISPLAY_TYPE_EX) = DT_ROOM Then
                    bDelete = False
                End If
            End If
        End If
    End If
    '
    If bDelete Then
        resRecip.Delete
    Else
        resRecip.Type = olResource
        Set resRecip = apptItem.Recipients.Add("=" & apptItem.Location)
        resRecip.Resolve
        resRecip.Type = olResource
        apptItem.Save
    End If
End Sub

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

IMAP では色分類項目が使えない

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


助けてほしいです。
小さい転職先の会社でOutlook 2013をIMAPで使っているのですが、色分類項目が使えません。POPに変えると他の端末(IPHONE)からメールが見れないくなると聞きました。この分類項目を是非使いたのですが、方法はあるのでしょうか?
宜しく、お願い致します。


IMAP フォルダーのメールは、サーバー上のものと同期しており、ローカルで変更を加えた場合はサーバー上のメールも更新する必要があります。
一方、色分類項目は Outlook 独自の機能であり、IMAP サーバー上に同期することはできないため、IMAP フォルダー上では使用できません。
したがって、色分類項目を使いたい場合は、PST ファイルを追加し、メールを PST に移動する必要がありますが、そうするとほかの端末から見えなくなるということになります。

もし、IMAP サーバー上でフォルダーの振り分けをしていないのであれば、POP に切り替えたほうが良いでしょう。
POP を使っている場合でも、サーバーにメールを残すという設定をすれば、他の端末からでもメールが読めるようになります。
ただし、IMAP とは異なり、未読・既読の状態は端末ごとに保持され、他の端末で既読にしたメールでも、その端末で読んでいないメールは未読となります。

色分類項目を使いつつ、他の端末でも未読・既読状態やフォルダーの階層情報を維持したいということになると、Exchange サーバーを使用するしか方法はないといえます。

Exchange Online でやってはいけない 10 のこと

以前、Outlook でやってはいけない 10 のことという記事で Outlook を使用するうえで問題が発生しうる使用方法について説明しましたが、Exchange Online 環境ではクラウド サービスという性質上、オンプレでは問題なかったものの、クラウドでは注意が必要な使い方というものがあります。
今回はそのような使い方などについて説明します。

1. オンライン モードで使用する

クライアント端末の紛失や盗難に備え、クライアント上に情報を保持させないようキャッシュ モードではなくオンライン モードで Outlook を使用するというのはよくある使い方です。
しかし、Exchange Online ではキャッシュ モードが強く推奨されています。
これは、インターネットの通信遅延によるものです。
Exchange Online への接続にはインターネットが使用されるため、クライアントからサーバーへのアクセスは複数のルーターやネットワークを経由する場合があります。
そして、経由するルーターやネットワークが多くなればなるほど、少しずつパケットの遅延が累積していき、クライアントからのリクエストに対するサーバーの応答が遅くなることになります。
オンライン モードで使用している場合、アイテムの一覧表示やアイテムの表示、変更など、Outlook のほとんどすべての操作でサーバーとの通信が発生するため、それらがすべて遅くなる可能性があり、ネットワークによっては使用に耐えられない状況となる場合があります。
残念ながら、インターネットの通信遅延については改善する方法はほとんどないため、オンライン モードでパフォーマンスを改善する方法はないといってよいでしょう。
どうしてもクライアントにデータを置くことができないのであれば、Outlook をオンライン モードで使用するより Outlook on the Web (OotW) を使ったほうが良いかもしれません。

2. 最新でないバージョンで使用する

延長サポートに入っているものも含めて、現在サポートされている Office のバージョンは 2007、2010、2013、2016 とあります。
そして、現時点では Exchange Online には、現在サポートされているすべての Outlook のバージョンで接続できることが可能です。
しかし、この状況はいつまでも続くものではありません。
Outlook 2007 のサポートが終了を迎える 2017 年 10 月に、Exchange Online で RPC/HTTP での接続が終了します。
RPC/HTTP とは Exchange Online に接続するための方法のひとつで、現在は RPC/HTTP という方法と MAPI/HTTP という方法の 2 つがサポートされているのですが、2017 年 10 月 31 日に RPC/HTTP が廃止され、MAPI/HTTP に一本化されるのです。

ここで問題となるのは Outlook 2007 です。
Outlook 2010 以降では修正プログラムの適用などで MAPI/HTTP が使用可能となっていますが、Outlook 2007 には MAPI/HTTP を使用する方法が用意されていません。
そのため、10 月 31 日以降は Outlook 2007 で Exchange Online に接続することができなくなるということになります (メールの送受信だけで使うなら POP や IMAP で接続することは可能です)。

これまでは、サポートが終了するといっても自己責任で使用し続けるということはできましたが、RPC/HTTP の廃止は実質的にバージョンアップが強制されるものであり、相当のインパクトがあると考えられます。
今後も、古いバージョンで発生する問題が修正されなかったり、新しい機能が使用できないなどの不都合は出てくると考えられます。
Office 365 に限らず、クラウド環境は常に進化し続けることがメリットの一つであるため、そのメリットを享受する意味でも、最新のバージョンを使用したほうが良いでしょう。
もし、社内の都合などで特定のバージョンを使用し続けなければならないという制約があるなら、クラウドへの移行は見送ったほうが良いかもしれません。

3. Outlook の最新バージョンと他の Office 製品の古いバージョンを混在させる

上記にも関連することですが、Exchange Online への接続要件を満たすために、Office 全体のバージョン アップはせず、Outlook だけのバージョン アップを検討される方もいるようです。
しかし、Outlook と他の Office のバージョンが異なる場合、製品の連携などに制限が出ます。
例えば、Outlook と同じバージョンの Word がインストールされていない場合、Outlook のメール編集の際に Word を使用する一部の機能が使用できません。
また、Office ファイルの添付ファイル プレビューなども使用できません。
バージョン アップできない理由は様々あると思いますが、いずれはバージョン アップが必要になるのは確実であり、先送りすればそれだけ問題が増えていくと考えたほうが良いでしょう。

4. 参照権限以上で予定表を共有する

他のユーザーの予定を把握するため、予定表をグループなどで共有するというのはよくある使い方です。
しかし、参照権限以上で予定表を共有すると Exchange Online 特有の壁にぶつかる場合があります。
Outlook でほかのユーザーの予定表を開く場合、その予定表にアクセスするための個別の TCP セッションが必要となります。
問題はキャッシュ モードで [共有フォルダーをダウンロード] がオンになっている場合です。
この設定をしていると、Outlook は一度開いたほかのユーザーの予定表についても OST にキャッシュするのですが、このキャッシュ情報を常に最新にするために、Outlook の起動直後から TCP セッションを確立する動作となります。
そのため、例えば 30 個の予定表フォルダーを開いた場合、その後は常に 30 (RPC/HTTP の場合は 60) の TCP セッションを確立し、Outlook が終了するまでセッションを張り続けます。
これによりプロキシや NAT の TCP セッションが不足するという問題が生じる可能性があるのです。
これを回避するには [共有フォルダーをダウンロード] をオフにするというものが考えられますが、この設定にするとほかのユーザーの予定表表示が遅くなったり、多数のユーザーの予定表を表示する際に Outlook がハングアップする場合があります。
そのため、基本的には予定表の共有は [空き時間情報、件名、場所] という権限で行ったほうが良いでしょう。
この権限の場合、予定表フォルダーへのアクセスには個別の TCP セッションが不要となり、サーバーから一括で複数ユーザーの最新の情報を取得することが可能です。

5. オンプレと Exchange Online で同じ SMTP アドレスのメールボックスを並行運用する

オンプレから Exchange Online への移行にあたって、問題発生時の切り戻しを考えて、オンプレと Exchange Online の両方にメールボックスを用意して段階的に移行しようと考える方がいるようです。
結論から言うと、大体はうまくいきません。
まず、オンプレから Exchange Online への切り替えで、AutoDiscover の振り先だけ変えればクライアントの移行が完了する、と期待していると大幅に裏切られます。
Outlook の OST にはメールボックスの GUID というものが保持されており、この GUID は同じ SMTP アドレスを使っても全く違ったものが設定されます。
そして、Outlook は接続したメールボックスの GUID が OST に保存されている GUID と異なる場合、「一時メールボックスに接続した」と判断します。
その結果、以下のようなダイアログが表示されます。

「メールボックスは、一時的に Microsoft Exchange サーバーで移動されています。一時メールボックスは存在しますが、以前のデータの一部が含まれていない可能性があります。

一時メールボックスに接続するか、以前のデータをすべて使用してオフラインで作業することができます。以前のデータを使用する場合は、電子メール メッセージの送受信はできません。」

このメッセージの通り、この状態になるとオフラインで移行前のメールボックスのメールを参照するか、オンライン モードで Exchange Online のメールボックスにアクセスするかの二択になり、移行前のメールを自動的に Exchange Online に移動する、というようなこともできません。
さらに問題なのは、プロファイルがこの状態になると起動時に必ず上記のメッセージが表示されるようになり、AutoDiscover の振り先をオンプレに戻しても解消できないという点です。
これを解消するにはプロファイルの再作成しか方法はありません。

また、プロファイルの作り直しをするつもりでも、うまく AutoDiscover を制御できなければ想定外の情報を取得して上記の一時メールボックスの状態になる可能性があるので、「Exchange Online 移行のパフォーマンスとベスト プラクティス」にあるような方法での移行をお勧めします。

6. インターネット接続の帯域幅を増やさずに移行する

オンプレミスで Exchange サーバーを運用していたものを Exchange Online に移行する場合、インターネットへのトラフィックは増えることが予想されます。
ただ、どの程度増えるのかという予測は非常に難しいものです。
単純なメールの送受信量だけでなく、予定表などの共有状況などにより、トラフィックが大幅に増える可能性もあります。
そのため、現在のインターネット接続の帯域幅の使用量がすでに飽和状態に近いのであれば、帯域幅を増やす必要があるでしょう。
帯域幅の増やさずに、Exchange Online へのトラフィックを制限しようとしても、効果的な方法は実際のところありません。
なぜなら、そもそも無駄なトラフィックを発生させるような設計にはなっていないためです。
現時点で帯域幅に多少の余裕があっても、使用状況によってはすぐにひっ迫する可能性もあるので、インターネット接続の増速がどのくらいの期間と費用でできるのかを、移行前にあらかじめ見積もっておくと安心です。
もし、増速が難しいような状況なのであれば、Exchange Online への移行は見送ったほうが良いかもしれません。

7. 自社で IT インフラの要員を確保しない

クラウド サービスへの接続で問題が発生する場合、原因としては大きく分けて以下のようなものが考えられます。

    1) クラウド サービスのサイト内のサーバーやネットワークの問題
    2) クラウド サービスと自社ネットワークの間のインターネットの問題
    3) 自社ネットワーク内のルーターやプロキシなどネットワークの問題
    4) クライアントの問題

このうち、クラウド サービスのサポートに問い合わせて対応してもらえるのは、1) と 4) です (サービスによっては 1)  だけの場合もあります)。
しかし、2) や 3) についてはクラウド サービスが用意するものではないため、サポートの対応には限界があります。
クラウドにしてしまえば自社の IT 要員が不要、と勘違いしていると、いざ 2) や 3) で問題が生じたときに、誰も対応できないという事態に陥ります。
そのため、クラウド サービスを使う場合でも、自社の IT インフラをサポートできる要員を確保するべきです。

8. Outlook から IMAP で接続する

Outlook には IMAP でサーバーに接続する機能があります。
また、Exchange Online には IMAP でクライアントからの接続を受ける機能があります。
したがって、Outlook から Exchange Online に IMAP で接続することは技術的には可能であり、サポート対象外ということもありません。
そのため、以下のような理由で Exchange Online に IMAP で Outlook から接続することを検討される方もいるようです。

  • 古いバージョンの Outlook で接続したい
  • オンプレや別サービスと同じ SMTP アドレスを使いたい

ただ、本来は Outlook や Exchange Online の IMAP 機能はサードパーティ製のメール サーバー/クライアントと接続するためのものであるため、IMAP を使用した場合には Exchange や Outlook 固有の機能が使えず、メリットがほとんどありません。
また、このような使い方はレアなケースであるため、想定外の不具合に遭遇する可能性が高いと考えられます。
したがって、IMAP で接続するくらいなら、OotW を使ったほうがより Exchange Online のメリットを享受できるといえます。

9. 原因追及を要求する

クラウド サービスではオンプレとは比べ物にならない台数のサーバーが常時稼働しています。
そして、一定の割合でハードディスクやネットワーク機器の物理的な故障などが発生することが想定されます。
そのため、語弊を恐れず言えば、クラウド サービスでは常に何らかのトラブルが生じていると考えられます。
もちろん、そのようなハードウェアの障害が発生しても、ユーザーに影響を与えないような構成となっているわけですが、それでも予期せぬトラブルというものは発生するものです。
オンプレ環境の場合、サーバーのダウンや障害などが発生した際には、原因追及や再発防止などの対策をとると思いますが、クラウドで同じレベルの原因追及や再発防止策の要求は極めて困難です。
というのも、車に例えるなら、オンプレは自家用車のようなものであり、クラウドというのは乗り合いバスのようなものだからです。

オンプレ環境は、ハードウェアは自前で持つことにより、トラブル発生時の対応や調査も自分で行う必要があります (SIer にすべて任せるという手もありますが)。
その代わり、いつまでも古いバージョンを使い続けたり、特殊な使い方をすることもできます。

一方、クラウド環境は多数のユーザーとハードウェアやソフトウェアを共有するものであり、基本的には自動的に最新のバージョンに更新され、使用方法の自由度はオンプレと比べて制限があります。
その代わり、メンテナンスはクラウド サービスに任せることができます。

したがって、クラウド サービスを使うに当たっては、サービス提供者を信頼し、トラブルが生じても原因追及や再発防止も含めて一任することにしてしまうのが良いと思います。
トラブルのたびに原因追及や再発防止策が提示されなければ不安ということは、いわば信頼できないクラウド サービスを使用しているということなので、そのようなサービスに自社のデータを預けるべきではないでしょう。

10. エンド ユーザーの要求をすべて実現しようとする

前述の通り、クラウド サービスではオンプレに比べて設定や拡張性に制限があり、エンド ユーザーの要求をすべて実現しようとすると、様々な障害に遭遇する可能性があります。
例えばメールの送受信数制限のようなサービス全体に影響を与えうるものについては、クラウドとオンプレでは設定できる範囲が異なり、たとえ一時的であっても、その制限を超えるような方法は用意されていません。
そのような状況で要求を実現しようとしても、特別対応される可能性はほとんどないでしょう。
また、クラウド サービスではある日突然 (実際には事前にアナウンスされていることがほとんどなのですが) 新機能がリリースされ、メニューが追加されたり、反対に機能が削除されたりする場合があります。
それについて機能を増やしたくないとか、削除されると困るというようなことを言っても、対応される可能性は低いといえます。
したがって、クラウド サービスを使うに当たっては、エンド ユーザーの様々な要求 (ローカルにデータを置きたくない、バージョンアップしたくない、全員の予定表の詳細を見たいなど) をすべて実現しようとせず、基本的にあるがままを受け入れるというスタンスで使うほうが良いでしょう。
もし、エンドユーザーを説得する自信がないのであれば、クラウドへの移行は見送ったほうが良いかもしれません。

まとめ

Exchange Online について、様々な制限を書いてしまったため、クラウドよりオンプレのほうが良いと思われる方もいるかもしれません。
しかし、オンプレでは使用できない最新の機能が Exchange Online なら使用可能であり、サーバーのメンテナンスからも解放されるという大きなメリットがあります。
いずれにせよ、クラウドとオンプレで全く同じ運用や使い方はできないと認識し、クラウドの特性を生かした使い方をすることで、より安定して快適な運用ができるようになるでしょう。

決まった件名で終わるメッセージを受信したら、キーワードを含む 1 行を CSV ファイルに保存するマクロ

決まった件名のメッセージを受信したら、データを CSV ファイルに保存するマクロのコメントにて以下のご要望をいただきました。


横から失礼します。
本件に近い操作をしたいと考えています。
1.一定の文言が含まれるメールが対象
2.対象としたメール本文から、対象となる文言が含まれる部分(1行)を抜き出し、CSV化
具体的には
1.件名:「~を入力しました。」 ※「~」は、都度 異なります。
2.本文:「●:●● ■■会議 予約済」 →この「予約済」を対象として、その1行を抜き出してCSV化で一覧にしたいと思っています。
このような操作は可能でしょうか?また、どのように設定すれば良いでしょうか?
ご教示、お願い致します。
※初心者につき、説明がわかりにくいようでしたら すみません。

12で質問させていただいた内容に追記させてください。
受信時間と件名もCSVに記載したいです。
まとめると・・・
1.件名の「~を入力しました」をKeyにして
2.件名(フル)と受信時間+本文の一部(●:●● ■■会議 予約済 ←「予約済」をKeyに1行を抜き出す)をCSV化
したいです。
ご教示、よろしくお願いします。


変更点は以下の 2 になります。

  • 件名の先頭部分は可変
  • キーワードを含む 1 行を抽出

件名の一部が一致するという条件を指定する場合は LIKE という演算子を使用します。
例えば、「~を入力しました。」の「~」が可変なのであれば、以下のような条件定義になります。
    If myMsg.Subject Like "*を入力しました。"  Then

また、1 行を抜き出すというのは、言い換えると「キーワードの前後の改行を検索し、その間の文字列を取得する」ということになります。

まとめると、以下のようなマクロで実現できます。

' ここをトリプルクリックでマクロ全体を選択できます。

' ここをトリプルクリックでマクロ全体を選択できます。
Private Sub Application_NewMailEx(ByVal EntryIDCollection As String)
    SaveLineToCsv EntryIDCollection
End Sub
'
Private Sub SaveLineToCsv(ByVal EntryIDCollection As String)
    Const AUTO_SAVE_TITLE_SUFFIX = "を入力しました。" ' 自動処理するメールの件名の終わりの文字
    Const CSV_FILE = "c:\temp\data.csv" ' データを保存する CSV ファイルの名前
    Const SEARCH_KEY = "予約済み" ' 本文で検索するキーワード
    Dim i As Integer
    Dim arrEntryId
    Dim myMsg
    Dim stmCsv
    Set stmCsv = Nothing
    arrEntryId = Split(EntryIDCollection, ",")
    For i = LBound(arrEntryId) To UBound(arrEntryId)
        Set myMsg = Application.Session.GetItemFromID(arrEntryId(i))
        If myMsg.Subject Like "*" & AUTO_SAVE_TITLE_SUFFIX Then
            Dim s As Integer
            Dim e As Integer
            Dim strLine As String
            If stmCsv Is Nothing Then
                Dim objFSO
                Set objFSO = CreateObject("Scripting.FileSystemObject")
                Set stmCsv = objFSO.OpenTextFile(CSV_FILE, 8, True, 0)
            End If
            ' キーワードを本文から検索
            e = InStr(myMsg.Body, SEARCY_KEY)
            If e > 0 Then ' キーワードを含む場合だけ処理
                ' キーワードを含む行の最初 (=直前の行の改行) を検索
                s = InStrRev(myMsg.Body, vbLf, e)
                If s = 0 Then
                    s = 1 ' 改行がなければ本文の先頭から
                End If
                e = InStr(e, myMsg.Body, vbCr)
                'キーワードを含む行の終わりを取得
                If e = 0 Then
                    e = Len(myMsg.Body)
                End If
                ' キーワードを含む行を取得
                strLine = Mid(myMsg.Body, s, e - s)
                strLine = Replace(strLine, vbCr, "")
                strLine = Replace(strLine, vbLf, "")
                stmCsv.WriteLine myMsg.Subject & "," & myMsg.ReceivedTime & "," & strLine
            End If
        End If
    Next
    If Not stmCsv Is Nothing Then
        stmCsv.Close
    End If
End Sub

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

10 周年 & Outlook 2016/2013 の累積的な修正プログラム 2017 年 1 月分がリリース

2007 年にこのブログをはじめて、10 周年になりました。

実は 2013 年をピークにアクセス数が減少傾向にあったのですが、昨年は 10,000 程度微増となり、年間 100 万アクセスをキープすることができました。
今でも「Outlook マクロ」で検索するとトップで表示されており、これもひとえにコメントで様々なご要望をお寄せくださる読者の方々のおかげと感謝しております。

これからも、Outlook を活用してもらうべく、様々なマクロや Tips を紹介してまいりますので、よろしくお願いいたします。

さて、年明け早々 Office 2016 および Office 2013 の累積的な修正プログラムがリリースされました。
以下は各製品のそれぞれの KB へのリンクです。

Office 2016

Outlook 2016 の修正

January 3, 2017, update for Outlook 2016 (KB3141453)
10 件の不具合修正が行われています。

Exchange アドインの修正

January 3, 2017, update for Office 2016 (KB3128056)
Outlook 2016 の Exchange アドインの不具合が 1 件修正されています。

Office 2016 共通コンポーネントの修正

January 3, 2017, update for Office 2016 (KB3141473)
Outlook 2016 関連の不具合が 1 件修正されています。

Office 2013

Outlook 2013 の修正

January 3, 2017, update for Outlook 2013 (KB3141466)
8 件の不具合修正が行われています。

本文から取得したデータを項目別に Excel のシートに書き出すマクロ

メールの内容を Excel ファイルにかき出すマクロ のコメントにて以下のご要望をいただきました。


はじめまして。
横からの質問で申し訳ありません。
どうしても自分では解決できずなんとかお力をお借りしたいと思います。

メールの本文中、

【 ご予定日 】 12月
【 日 】 31日
【 泊数 】 1泊
【 名前 】 山田 太郎
【 郵便番号 】 4562215
【 ご住所 】 愛知県豊明市西町5丁目111-111
【 マンション名等 】豊明マンション101
【 Email 】 taroyamada@yahoo.co.jp
【 tel1 】 0902200000
【 ご予約人数 】 2人
【 小学生以下人数 】 1人

のように項目ごとのフォーム送信がある場合、エクセルの2行目以降のセルに

(A1) (B1) …
ご予定日 日 泊数 名前 郵便番号 …
(A2) (B2) …
12 31 1 山田 太郎 4562215 …

のように①、メール本文内の項目の後の文字列を抽出し、エクセルの対象項目に対して個別にエクスポートすることは可能なのでしょうか?
またその折②、日にち、泊数などは数字のみ抽出できればうれしいです。
outlookのエクスポート機能はwordの差し込みフィールドのように使えて便利そうなのですが2003以降のバージョンには対応していないようですし、本文中の項目までは当然読み込めませんのでなんとかマクロで解決できればと思っております。
ただ、マクロはネットで引っ張りながらさわるぐらいしかできません。
こういった投稿、コメントに不慣れで甚だ不躾ではございますが是非ご教示頂ければ幸いです。
宜しくお願い申し上げます。

追記です。
出来れば既存のエクセルデータsheet内のセルに挿入できればと考えています。


本文から項目を取り出すというような便利な関数は Outlook には用意されていませんが、VBA の文字列検索関数を使って実現することはできます。
マクロは以下の通りです。

' ここをトリプルクリックでマクロ全体を選択できます。
Public Sub ExportBodyToExcel()
    ' エクスポートする Excel ファイルのファイル名を指定
    Const EXCEL_FILE = "c:\temp\book1.xlsx" 
    Dim objBook As Object
    Dim objSheet As Object
    Dim r As Integer
    Dim strBody As String
    ' Excel ファイルを開く
    Set objBook = GetObject(EXCEL_FILE)
    objBook.Windows(1).Activate
    Set objSheet = objBook.Worksheets(1)
    ' 空行を探す
    r = 1
    While objSheet.Cells(r, 1) <> ""
        r = r + 1
    Wend
    ' メールをどのように開いているか確認
    If TypeName(Application.ActiveWindow) = "Inspector" Then
        strBody = ActiveInspector.CurrentItem.Body
    Else
        strBody = ActiveExplorer.Selection(1).Body
    End If
    ' セルに本文から取得したデータを格納
    objSheet.Cells(r, 1) = GetValueByToken(strBody, "ご予定日", True)
    objSheet.Cells(r, 2) = GetValueByToken(strBody, "日", True)
    objSheet.Cells(r, 3) = GetValueByToken(strBody, "泊数", True)
    objSheet.Cells(r, 4) = GetValueByToken(strBody, "名前", False)
    ' 郵便番号は文字列として保存
    objSheet.Cells(r, 5) = "'" & GetValueByToken(strBody, "郵便番号", False)
    objSheet.Cells(r, 6) = GetValueByToken(strBody, "ご住所", False)
    objSheet.Cells(r, 7) = GetValueByToken(strBody, "マンション名等", False)
    objSheet.Cells(r, 8) = GetValueByToken(strBody, "Email", False) 
    ' 電話番号は文字列として保存
    objSheet.Cells(r, 9) = "'" & GetValueByToken(strBody, "tel1", False)
    objSheet.Cells(r, 10) = GetValueByToken(strBody, "ご予約人数", True)
    objSheet.Cells(r, 11) = GetValueByToken(strBody, "小学生以下人数", True)
    ' 項目を追加したければ以下のフォーマットで追加 
    ' objSheet.Cells(r, 列番号) = GetValueByToken(strBody,"項目名", True) '数字のみ取り出す場合 
    ' objSheet.Cells(r, 列番号) = GetValueByToken(strBody,"項目名", False) '文字列として取り出す場合
    ' 変更したファイルを保存
    objBook.Save
    objBook.Close
    MsgBox "保存しました。"
End Sub
'
'  本文から指定された項目のデータを取得する関数
'
Private Function GetValueByToken(strBody As String, strToken As String, bNumOnly As Boolean)
    Dim i As Integer
    Dim strLine As String
    Dim strValue As String
    Dim c As String
    i = InStr(strBody, "【 " & strToken & " 】")
    If i > 0 Then
        strValue = ""
        strLine = Mid(strBody, i + Len(strToken) + 4)
        i = InStr(strLine & vbCrLf, vbCrLf)
        ' 余計な空白を削除
        strValue = Trim(Left(strLine, i - 1))
        If bNumOnly Then  ' 数字のみが指定された場合
            For i = 1 To Len(strValue)
                c = Mid(strValue, i, 1)
                If c < "0" Or "9" < c Then
                    strValue = Left(strValue, i - 1)
                    Exit For
                End If
            Next
        End If
        GetValueByToken = strValue
    Else
        GetValueByToken = ""
    End If
End Function

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

メール本文中のハイパーリンクを置き換えるマクロ

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


お世話になります。
仕事でOutlook2010をOffice365サーバー環境で使用しています。
Outlookメール本文中のハイパーリンクを変更したい件でご相談させてください。
今回、会社の組織変更で、Windowsファイルサーバーの格納先パスを変更する必要が出てきました。
従来、
\\Fsrv02\913-ABC\01グループ公開\50役立つ資料」のパスを
\\Fsrv02\602-XYZ\001グループ公開\50役立つ資料」に変更する必要がある状況です。
その際、メール本文中にあるハイパーリンクを置き換えしたいのです。
メールには、
テキスト形式
HTML形式
リッチテキスト形式が混在しています。
メールは複数あり、フォルダー内すべてのメール本文を対象に検索して置き換えたい状況です。
できれば、テキストファイルに、変更前パスと、変更後パスを指定して、汎用性がもたせたら尚うれしいです。
弊サイトの情報も見させていただいたのですが、私の探し方が未熟なため、サンプルプログラムとして使わせていただけそうなものが見つかりませんでした。
どうか、宜しくお願い申し上げます。


以下のようなマクロで実現できます。 REPLACE_FILE で指定したファイル名のテキストファイルに、変更前のパスと変更後のパスを 1 行ずつタブで区切って格納してください。

' ここをトリプルクリックでマクロ全体を選択できます。
Public Sub ReplaceLinksInFolder()
    Const REPLACE_FILE = "c:\temp\replacelinks.txt"
    Dim objFSO As Object
    Dim stmFile As Object
    Dim strReplace As String
    Dim arrLine As Variant
    Dim arrOld() As String
    Dim arrNew() As String
    Dim i As Integer
    ' パスの変換情報をファイルから読み込み
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    Set stmFile = objFSO.OpenTextFile(REPLACE_FILE)
    strReplace = stmFile.ReadAll()
    stmFile.Close
    arrLine = Split(strReplace, vbCrLf)
    ReDim arrOld(UBound(arrLine))
    ReDim arrNew(UBound(arrLine))
    For i = LBound(arrLine) To UBound(arrLine)
        Dim arrField As Variant
        If InStr(arrLine(i), vbTab) = 0 Then
            ReDim Preserve arrOld(i)
            ReDim Preserve arrNew(i)
            Exit For
        End If
        arrField = Split(arrLine(i), vbTab)
        arrOld(i) = arrField(0)
        arrNew(i) = arrField(1)
    Next
    ' アイテムごとにパスの変換を行う
    Dim objItem As MailItem
    For Each objItem In ActiveExplorer.CurrentFolder.Items
        If objItem.BodyFormat = olFormatPlain Then
            ' テキスト形式なら単純なテキスト置き換え
            Dim strNewBody As String
            strNewBody = objItem.Body
            For i = LBound(arrOld) To UBound(arrOld)
                strNewBody = Replace(strNewBody, arrOld(i), arrNew(i))
            Next
            If strNewBody <> objItem.Body Then
                objItem.Body = strNewBody
                objItem.Save
            End If
        Else
            ' HTML または RTF の場合は Word コンポーネントを使用して置き換え
            Dim objInsp As Inspector
            Dim objWord As Object ' Word.Document
            Dim objLink As Object ' Word.Hyperlink
            Dim bFound As Boolean
            Set objInsp = objItem.GetInspector()
            Set objWord = objInsp.WordEditor
            ' テキスト置き換えを可能にするため、[メッセージの編集] を実行
            objInsp.Display
            objInsp.CommandBars.ExecuteMso "EditMessage"
            bFound = False
            For Each objLink In objWord.Hyperlinks
                For i = LBound(arrOld) To UBound(arrOld)
                    ' リンクアドレスが置き換え前の文字列で始まる場合は置き換え
                    If objLink.Address Like arrOld(i) & "*" Then
                        bFound = True
                        objLink.Address = Replace(objLink.Address, arrOld(i), arrNew(i))
                        If objLink.TextToDisplay Like arrOld(i) & "*" Then
                            objLink.TextToDisplay = Replace(objLink.TextToDisplay, arrOld(i), arrNew(i))
                        End If
                    End If
                Next
            Next
            If bFound Then
                objItem.Save
            End If
            objInsp.Close olDiscard
        End If
    Next
End Sub

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