特定の条件のメールを受信した際に、本文に記載された IP アドレスへ ping するマクロ

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


はじめまして

本文にIPアドレスを含むメールが飛んでくるのでそのメールが着たらpingを自動で投げるようにしたいのですが、できますでしょうか?

[環境]
os:win7 pro
  outlook 2010

メール
件名:障害発生
  本文「
IPアドレス:○○.○○.○○.○○
障害時間:yyyy:mm:dd hh:mm
障害ログ:~~~~~
  」


メールの受信時に実行される Application_NewMailEx イベントでマクロを実行することで自動処理が可能になります。
Ping のような外部コマンドをマクロから実行する場合、VBA の Shell 関数を使用します。
マクロは以下のようになります。

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

Private Sub Application_NewMailEx(ByVal EntryIDCollection As String)
     Dim objItem As Object
     Dim strBody As String
     Dim iIpStart As Integer
     Dim iIpEnd As Integer
     Dim i As Integer
     Dim ch As String
     Dim strIpAddr As String
     ' エントリー ID からアイテムを取得
     Set objItem = Session.GetItemFromID(EntryIDCollection)
     ' アイテムがメールで件名が「障害発生」か確認
     If objItem.MessageClass = "IPM.Note" And objItem.Subject = "障害発生" Then
         strBody = objItem.Body
         ' IP アドレスで始まる行の開始と終了を取得
         iIpStart = InStr(strBody, "IPアドレス")
         iIpEnd = InStr(iIpStart, strBody, vbCrLf)
         strIpAddr = ""
         ' IP アドレスの文字列を取得
         For i = iIpStart To iIpEnd
             ch = Mid(strBody, i, 1)
             If InStr("0123456789.", ch) > 0 Then
                 strIpAddr = strIpAddr & ch
             End If
         Next
         ' Ping コマンドを実行
         Shell "ping -t " & strIpAddr
     End If
End Sub

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

マクロで書式設定した文字列を予定アイテムの本文に書き込む方法

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


お世話になります。OUTLOOKの予定表の本文中の書式設定(フォント、色、サイズ)を変更したいのですが、

どのようにしたらできるでしょうか?ご教示ください。

現状、objITEM.Body= ” xxxxxxxx ” にて本文を設定しています。

メールの場合には .HTMLBody= “” & “” などで、変更できたのですが。

お手数ですがよろしくお願いいたします。


Outlook 2013 まで、予定アイテムや仕事アイテムは常にリッチテキスト形式でした。
Outlook 2016 からは予定アイテムでもリッチテキスト以外の形式が選択できるようになりましたが、以前の動作を引き継いでいるためか、AppointmentItem には HTMLBody プロパティがありません。

リッチテキスト形式の本文を格納する RTFBody プロパティもあるのですが、リッチテキスト形式のデータは HTML に比較するとかなり複雑なものとなっており、これを使って書式設定を行うというのはちょっと現実的ではありません。

そこで、予定表の本文で書式設定を行いたい場合は、本文の編集に使用されている Word コンポーネントを利用します。

InspectorWordEditor プロパティで取得できる Word の Document オブジェクトを使用すると、本文に書式設定を行った文字列を書き込むことができます。

以下のマクロは、本文に様々な書式設定の文字列を書き込むサンプルです。

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

Public Sub WriteRichTextToBody()
     Dim wrdEditor As Object ' Word.Document
    ' Word のコンポーネントを取得
     Set wrdEditor = ActiveInspector.WordEditor
     ' Selection オブジェクトで書き込みを行う
     With wrdEditor.Application.Selection '
         ' フォント指定の例
         .Font.Name = "Meiryo"
        ' フォントサイズ指定の例
         .Font.Size = 10
         ' 太字の例
         .Font.Bold = True
         .TypeText "太字" & vbCrLf
         .Font.Bold = False
         ' 斜体の例
         .Font.Italic = True
         .TypeText "斜体" & vbCrLf
         .Font.Italic = False
         ' 下線の例
         .Font.Underline = True
         .TypeText "下線" & vbCrLf
         .Font.Underline = False
         ' 色指定: 赤
         .Font.ColorIndex = 6 ' wdRed
         .TypeText "red" & vbCrLf
         ' 色指定: 緑
         .Font.ColorIndex = 11 ' wdGreen
         .TypeText "green" & vbCrLf
         ' 色指定: 青
         .Font.ColorIndex = 2 ' wdBlue
         .TypeText "blue" & vbCrLf
     End With
End Sub

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

転送の際に元の差出人を返信先として設定するマクロ

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


こんにちは。

実は初めましてではありません。以前も助けていただいたことがあります。
そのときは、ありがとうございました。

私、とある任務を持っています。それは、会社の代表メールに着信したメールを振り分けるという、それなりに大事なこと。

しかしOutlook(2013/2016)で普通に転送をすると、「送信者」は当然”私”となります。よって、転送メールを受け取った人は、それほど深く考えずメールに対し返信をすることで、すべて私に戻ってくるわけです。

これの解決策として、世の中には「リダイレクト」という仕組みが用意されています。Outlookでも「仕分けルール」を使うことで(自動的に)行えるようですが、自動的ではダメなのです。

受信したメールを確認し、”このメールは人事課”,”このメールは総務課”とひとつひとつ大事に転送を掛けていきたいのですが、Outlook(手動)でなんとか出来るようになりませんか?

よろしくお願いいたします。

風のピエロ


残念ながら、Outlook ではリダイレクトを実現することはできません。
仕分けルールでリダイレクトが使用できるのは、Exchange サーバーにリダイレクト機能が実装されており、サーバー上でルールが実行されるためです。

ただ、Outlook ではメールの返信先を指定できるので、転送の際に元のメールの差出人を返信先に指定すれば、転送メールの返信が元のメールの差出人に返されるようになります。

返信先の指定を自動的に行うマクロは以下のようになります。

' ここをトリプルクリックでマクロ全体を選択できます。
Public Sub ForwardWithReplyTo()
     Dim orgMail As MailItem
     Dim fwdMail As MailItem
     Dim oneRecip As Recipient
     Dim newRecip As Recipient
     ' 現在表示中のメールを取得
     Set orgMail = ActiveInspector.CurrentItem
     ' 転送メールを作成
     Set fwdMail = orgMail.Forward
     ' 転送メールの返信先に元のメールの差出人を追加
     Set newRecip = fwdMail.ReplyRecipients.Add(orgMail.SenderEmailAddress)
     newRecip.Resolve
     ' 転送メールの返信先に元のメールの宛先、Cc を追加
     For Each oneRecip In orgMail.Recipients
         Set newRecip = fwdMail.ReplyRecipients.Add(oneRecip.Address)
         newRecip.Type = oneRecip.Type
         newRecip.Resolve
     Next
     ' 転送メールを表示
     fwdMail.Display
End Sub

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

Outlook 2016/2013/2010/ 2007 のセキュリティ修正プログラム 2017 年 7 月分がリリース

7/27 に Office 2016, 2013, 2010 および 2017 の定例外のセキュリティ修正プログラムがリリースされました。以下は各製品のそれぞれの KB へのリンクです。

Office 2016

Outlook 2016 のセキュリティ修正

Description of the security update for Outlook 2016: July 27, 2017

3 件のセキュリティ修正が行われています。

Office 2013

Outlook 2013 のセキュリティ修正

Description of the security update for Outlook 2013: July 27, 2017
3 件のセキュリティ修正が行われています。

Office 2010

Outlook 2010 のセキュリティ修正

Description of the security update for Outlook 2010: July 27, 2017
3 件のセキュリティ修正が行われています。

Office 2007

Outlook 2007 のセキュリティ修正

Description of the security update for Outlook 2007: July 27, 2017
3 件のセキュリティ修正が行われています。

なお、上記の修正プログラムを適用すると 6 月のセキュリティ修正を適用することで発生していた不具合の多くが修正されます。
詳細については以下のリンクを参考にしてください。
2017 年 6 月セキュリティ更新プログラムの Outlook の既知の問題

会議室の一覧を取得するマクロ

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


はじめまして。

マクロを使用して、現在登録されている会議室名をすべて取得したいと考えています。

どのような関数を利用して、実現するのがよいのかお知恵を拝借できれば幸いです。


登録されている会議室名というのは、Exchange サーバーの会議室メールボックスとして登録されているアカウントの名前ということでよいでしょうか?
会議室の一覧を取得するというような関数はありませんので、以下のような手順で取得する必要があります。

  1. アドレス帳の一覧からグローバル アドレス一覧を取得する
  2. グローバル アドレス一覧のエントリーから PR_DISPLAY_TYPE_EX の値が DT_ROOM であるエントリーを抽出して取得する

マクロにすると以下のようになります。
取得した会議室名をどのように使うのかがわからなかったので、この関数では会議室名を文字列の配列に格納して返しています。

' ここをトリプルクリックでマクロ全体を選択できます。
Public Function GetRooms() As String()
     On Error Resume Next
     Const PR_DISPLAY_TYPE_EX = "http://schemas.microsoft.com/mapi/proptag/0x39050003"
     Const DT_ROOM = 7
     Dim alGAL As AddressList
     Dim aeUser As AddressEntry
     Dim strRooms As String
     ' Exchange のグローバル アドレス一覧を取得
     For Each alGAL In Session.AddressLists
         If alGAL.AddressListType = olExchangeGlobalAddressList Then
             Exit For
         End If
     Next
     ' グローバル アドレス一覧から会議室メールボックスを検索
     strRooms = ""
     For Each aeUser In alGAL.AddressEntries
         If aeUser.AddressEntryUserType = olExchangeUserAddressEntry Then
             Dim lType As Long
             lType = aeUser.PropertyAccessor.GetProperty(PR_DISPLAY_TYPE_EX)
             ' PR_DISPLAY_TYPE_EX が DT_ROOM なら会議室
             If lType = DT_ROOM Then
                 strRooms = strRooms & aeUser.Name & vbTab
             End If
         End If
     Next
     ' 会議室一覧の文字列を配列に変換
     If Len(strRooms) > 0 Then
         strRooms = Left(strRooms, Len(strRooms) - 1)
         GetRooms = Split(strRooms, vbTab)
     End If
End Function

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

本文の内容から時間を取得してフラグの期限を設定するマクロ

本文の内容からフラグの期限を設定するマクロのコメントにて以下のご要望をいただきました。


このマクロの応用で、時間を本文から取得してフラグを設定するマクロを作りたいのですが、理解が足りず挫折してしまいました。
やりたいことは、
・期限の日付は、メール受信の当日でOK
・「予定終了時間:」の後に続く時間(例:19:00)を取得して、その時間を期限として
 アラームが立ち上がるようなフラグを立てたい。

どう書き換えればよいか、教えて頂けないでしょうか?


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

' ここをトリプルクリックでマクロ全体を選択できます。
Public Sub AddFlagWithAlarmByTime()
     Dim objMsg As MailItem
     Dim i As Integer
     Dim strTime As String
     Dim strDate As String
     '
     If Not ActiveInspector Is Nothing Then
         Set objMsg = ActiveInspector.CurrentItem
     ElseIf ActiveExplorer.Selection.Count = 1 Then
         Set objMsg = ActiveExplorer.Selection(1)
     Else
         MsgBox "メッセージを開くか、選択してください。", vbCritical, "フラグ追加"
         Exit Sub
     End If
     '
     i = InStr(objMsg.Body, "予定終了時間:")
     If i > 0 Then
         i = i + 7
         strTime = ""
         While InStr(" 0123456789:", Mid(objMsg.Body, i, 1)) > 0
             strTime = strTime & Mid(objMsg.Body, i, 1)
             i = i + 1
         Wend
         strDate = FormatDateTime(Now, vbShortDate) & " " & strTime
         '
         objMsg.MarkAsTask olMarkToday
         objMsg.FlagRequest = "ご確認ください"
         objMsg.TaskStartDate = Now
         objMsg.TaskDueDate = strDate
         objMsg.ReminderSet = True
         objMsg.ReminderTime = strDate
         objMsg.Save
     End If
End Sub

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

Outlook 2016/2013 でルールによるアプリケーションやマクロの実行ができない

2017 年 5 月以降にリリースされた Outlook 2016 の修正プログラム、または 6 月以降にリリースされた Outlook 2013 の修正プログラムを適用すると、以下のような現象が発生します。

  • アプリケーションやマクロを実行するルールが (エラー) と表示される
  • 新規ルール作成で「アプリケーションを開始する」や「スクリプトを実行する」というアクションが選択肢からなくなる

これは、セキュリティ強化に伴う動作変更です。

ただし、機能が完全に削除されたわけではなく、以下のレジストリ設定を行うことで引き続き「アプリケーションを開始する」や「スクリプトを実行する」というアクションが使用できるようになります。

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

Outlook 2013 のキー: HKEY_CURRENT_USER\Software\Microsoft\Office\15.0\Outlook\Security\

値の名前: EnableUnsafeClientMailRules

値の種類: REG_DWORD

値のデータ: 1

– 参考リンク

How to control the rule actions to start an application or run a macro in Outlook 2016 and Outlook 2013