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

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

Office 2016

Outlook 2016 のセキュリティ修正

2016 の Outlook のセキュリティ更新プログラムの説明: 2018 年 2 月 13日
2 件のセキュリティ修正と 5 件のセキュリティ以外の修正が行われています。

Office 2013

Outlook 2013 のセキュリティ修正

Outlook 2013 のセキュリティ更新プログラムの説明: 2018 年 2 月 13日
2 件のセキュリティ修正と 6 件のセキュリティ以外の修正が行われています。

Office 2010

Outlook 2010 のセキュリティ修正

Outlook 2010 用のセキュリティ更新プログラムの説明: 2018 年 2 月 13日
2 件のセキュリティ修正が行われています。

Office 2007

Outlook 2007 のセキュリティ修正

Outlook 2007 用のセキュリティ更新プログラムの説明: 2018 年 2 月 13日
2 件のセキュリティ修正が行われています。

広告

一定時間内に同じ件名のメールを複数受信したらメールを送信するマクロ

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


はじめまして。
Windows10+Outlook2013で、一定時間内に同じ件名のメールを受信したら指定のメールアドレスに定型文のメールを送信したいのですが可能でしょうか?
例えば、10分間に同じ件名のメールを10件受信したら指定アドレスにメールを送る。10分間隔でメールをチェックする仕掛けになるイメージになるのでしょうか。


例えば、10分間に10件受信したかどうかという判断は、メールを受信した際にその時間の10分前以降に受信した同じ件名のメールの数をカウントして10件以上あれば、という条件に置き換えられると思います。
Items コレクションの Restriction メソッドで件名と受信日時によりフィルタリングし、その数が一定数を超えたらメールを送信するというロジックにすればご要望は実現できるでしょう。
このロジックの場合、11件目を受信した際にどうするかという問題があるのですが、これについては通知メールを送信したタイミングをフィルタリングの開始時刻にするという方法で、新たに10件受信した場合に通知するようにしています。
マクロは以下のようになります。

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

Dim g_strLastSent As String
'
Private Sub Application_NewMailEx(ByVal EntryIDCollection As String)
     Dim objItem As Object ' MailItem
     '
     Set objItem = Session.GetItemFromID(EntryIDCollection)
     '
     If objItem.MessageClass = "IPM.Note" Then
         FindSameSubject objItem.Subject
     End If
End Sub
'
Private Sub FindSameSubject(strSubject As String)
     Const NOTIFY_TO = "test@example.com"
     ' 通知メールの件名
     Const MAIL_SUBJECT = "メール通知"
     ' 通知メールの本文
     Const MAIL_BODY = "メールを 10 分以内に 10 件受信しました。"
     ' 監視する時間 (分単位)
     Const INTERVAL_MIN = 10
     ' 通知するメール数の閾値
     Const MAX_MAILS = 10
     Dim fldInbox As Folder
     Dim colInbox As Items
     Dim dtStart As Date
     Dim strStart As String
     ' 受信トレイを取得
     Set fldInbox = Session.GetDefaultFolder(olFolderInbox)
     Set colInbox = fldInbox.Items
     ' 監視の開始時間を算出
     dtStart = DateAdd("n", -INTERVAL_MIN, Now)
     strStart = FormatDateTime(dtStart, vbShortDate) & " " & _
         FormatDateTime(dtStart, vbShortTime)
     ' 一度通知メールを送信したら、カウンタをクリアするための記述
     If g_strLastSent = "" Then
         g_strLastSent = strStart
     ElseIf g_strLastSent > strStart Then
         strStart = g_strLastSent
     End If
     ' 開始時間以降に受信した同一件名のメールの検索
     Set colInbox = colInbox.Restrict("[件名] = '" & strSubject & "' AND " & _
         "[受信日時] > '" & strStart & "'")
     ' 監視時間中に閾値を超えるメールを受信したら通知メール送信
     If colInbox.Count >= MAX_MAILS Then
         Dim mailNotify As MailItem
         Set mailNotify = Application.CreateItem(olMailItem)
         mailNotify.Subject = MAIL_SUBJECT
         mailNotify.Body = MAIL_BODY
         mailNotify.To = NOTIFY_TO
         mailNotify.Send
         ' メール送信時間を次の監視の開始時間とするロジック
         g_strLastSent = FormatDateTime(Now, vbShortDate) & " " & _
             FormatDateTime(Now, vbShortTime)
     End If
End Sub

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

送信済みアイテムのメールについて期間を指定して特定の文字列を件名に含むメールにテンプレートで返信するマクロ

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


はじめまして、はせがわと申します。
Outlookのマクロを作りたいとネットを検索していて貴サイトを拝見し、ご質問させていただきたく思いました。

やりたいこと
社員向けに500件くらいのメールをAccessから自動送信しています。
  本メールには社内試験の結果等をパスワードを付したファイルをメールに添付して受験者に送信しました。
パスワードを知らせるメールを受験生全員に上記メールに返信する形です送付したいと考えています。

具体的には、特定のメール(タイトルと日付)を探し出し、本メールへの返信メールを作成し、パスワードを連絡するメールを送信したい。
  1.送信トレイの中から、期間指定(YYYYMMD-YYYYMMDD)およびメールタイトル(キーワード部分一致:”結果送付のお知らせ”)で対象メールを特定する。
  2.対象メールにReplyAllで返信する形でメールを作成する。
  3.本文にパスワードを伝えるテンプレートを加える
4.送信

※知りたいところ、
  1.特定のフォルダからのメールの検索方法
  2.ReplyAllの返信メールを作成する方法

以上、よろしくお願いたします。


送信トレイの中から、とありますが、これは送信済みアイテムと考えてよいでしょうか?
アイテムを送信日時でフィルターするには Items オブジェクトの Find メソッドが使用できます。
また、メールの件名のキーワードの部分一致は Instr 関数を使用します。
下記のマクロでは C:\temp\password.oft として保存したテンプレート メールの本文で返信メールの本文を置き換え、送信しています。

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

Public Sub SendPasswordByReply()
     Const KEY_WORD = "結果送付のお知らせ"
     Const TEMPLATE_FILE = "c:\temp\password.oft"
     Dim strStart As String
     Dim strEnd As String
     Dim fldSent As Folder
     Dim colSent As Items
     Dim tmpMail As MailItem
     Dim orgMail As MailItem
     Dim repMail As MailItem
     ' 検索期間の開始と終了を入力
     strStart = InputBox("検索期間の開始日(YYYYMMDD)")
     strEnd = InputBox("検索期間の終了日(YYYYMMDD)")
     strStart = Left(strStart, 4) & "/" & Mid(strStart, 5, 2) & "/" & Right(strStart, 2)
     strEnd = Left(strEnd, 4) & "/" & Mid(strEnd, 5, 2) & "/" & Right(strEnd, 2)
     strEnd = DateAdd("d", 1, CDate(strEnd))
     ' テンプレートを取得
     Set tmpMail = Application.CreateItemFromTemplate(TEMPLATE_FILE)
     ' 送信済みアイテムフォルダーを取得
     Set fldSent = Session.GetDefaultFolder(olFolderSentMail)
     Set colSent = fldSent.Items
     ' 指定された期間に送信されたアイテムを検索
     Set orgMail = colSent.Find("[送信日時]>='" & strStart & "' And [送信日時]<'" & strEnd & "'")
     While Not orgMail Is Nothing
         ' 件名にキーワードを含むメールについて処理
         If InStr(orgMail.Subject, KEY_WORD) > 0 Then
             ' 全員に返信
             Set repMail = orgMail.ReplyAll
             ' テンプレートの本文を返信メールの本文と置き換え
             repMail.Body = tmpMail.Body
             ' テンプレートの本文を返信メールの先頭に入れる場合は以下のようにする
             ' repMail.Body = tmpMail.Body & repMail.Body
             ' メールを送信
             repMail.Send
         End If
         Set orgMail = colSent.FindNext
     Wend
End Sub

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

Exchange 環境下で組織外のアドレスに送信する際に警告を表示するマクロ

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


Windows7/ExchangeServer/Outlook2013の環境です。マクロについて教えて下さい。

複数のドメインが混在していた時に警告を表示するマクロ、を部内で共有させていただいておりますが、単一ドメインが自社ドメインに混在していた時にも警告を表示することは可能でしょうか。

例:社内向けの案内だったにもかかわらず、間違えて社外の人を1名入れてしまった。

(送信時に宛先に含まれるドメインの数で異なる警告メッセージを表示するマクロ、はうまく機能しませんでした。自分のドメインを認識してくれていないようすです)

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


Exchange サーバーを使用している環境で、組織外へのメール送信で警告を表示するというようなマクロは需要があるはずなのですが、意外とこれまで取り上げていませんでしたね。
Exchange 環境では組織内のアドレスは基本的に X.500 形式のものが使用されていますが、組織外のユーザーをメール連絡先として Active Directory に追加すると、組織外でも X.500 アドレスとなってしまいます。
また、組織内のユーザーを Outlook の連絡先に登録したり、組織内の差出人であっても認証しない SMTP セッションで送信したメールに返信したような場合には、想定外のアドレス形式になっていたりもします。
そのため、組織内であっても SMTP アドレスを取得し、そのアドレスのドメインで組織内かどうかを判断する必要があります。
これらの条件を考慮したマクロは以下のようになります。

' ここをトリプルクリックでマクロ全体を選択できます。
Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
     Const MY_DOMAIN = "*@example.com" ' 自組織のドメイン名を指定。@ の前に * を付ける
     Dim objRec As Recipient
     Dim strSMTPAddr As String
     Dim bOut As Boolean
     Dim bExternal As Boolean
     Dim strOut As String
     Dim iRet As Integer
     ' 組織外の受信者が複数存在するかどうかの確認
     bExternal = False
     strOut = ""
     For Each objRec In Item.Recipients
         strSMTPAddr = GetSMTPAddr(objRec)
         If Not strSMTPAddr Like MY_DOMAIN Then
             strOut = strOut & strSMTPAddr & ";"
             bExternal = True
         End If
     Next
     ' 組織外の受信者が複数含まれていた場合の処理
     If bExternal Then
         iRet = MsgBox("あて先に組織外のドメインのメールアドレスが含まれています。送信しますか?" & _
             vbCrLf & "外部ドメイン宛: " & strOut, vbYesNo, "送信確認")
         Select Case iRet
             Case vbYes
                 ' 送信日時を 1 分後に設定
                 Item.DeferredDeliveryTime = DateAdd("n", 1, Now)
                 Cancel = False ' 念のため
             Case vbNo
                 Cancel = True
         End Select
     End If
End Sub
' SMTP アドレス取得関数
Private Function GetSMTPAddr(objRec As Recipient)
     Const PR_ORIGINAL_DISPLAY_NAME = "http:" & "//schemas.microsoft.com/mapi/proptag/0x3a13001e"
     Const PR_SMTP_ADDRESS = "http:" & "//schemas.microsoft.com/mapi/proptag/0x39fe001e"
     Dim strSMTPAddr As String
     If objRec.AddressEntry.Type = "SMTP" Then
         strSMTPAddr = objRec.Address
     Else ' Exchange 対応
         If objRec.AddressEntry.AddressEntryUserType = olOutlookContactAddressEntry Then
             strSMTPAddr = objRec.AddressEntry.PropertyAccessor.GetProperty(PR_ORIGINAL_DISPLAY_NAME)
         Else
             strSMTPAddr = objRec.AddressEntry.PropertyAccessor.GetProperty(PR_SMTP_ADDRESS)
         End If
     End If
     GetSMTPAddr = strSMTPAddr
End Function

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

Windows 10 Fall Creators Update を適用すると発生する Outlook の問題について

現象

Windows 10 の Fall Creators Update (RS3) を適用すると、環境によっては Outlook で以下のようなトラブルが発生することがあります。

  • Windows Search による検索ができなくなる
  • 人物情報ウィンドウの関連アイテムが表示されなくなる
  • 検索の際にリボンの絞り込みが使えなくなる
  • Word や Excel などでファイルをメールで送信しようとすると MAPI のエラーが発生する
  • サードパーティ製のアプリケーションでメールを送信しようとすると MAPI のエラーが発生する

原因

これらはすべて Windows 10 の Fall Creators Update の適用プロセスにおいて、一部の MAPI 関連レジストリが削除されることが原因となっています。
適用プロセスの不具合であるため、修正プログラムなどでの対応は難しいと考えられます。

回避策

レジストリを復活させれば現象が回避できますが、手作業でレジストリを設定するのは困難であるため、Office の修復セットアップによりレジストリを回復する必要があります。

補足

Office のインストール形式が Click-To-Run である場合、削除されるレジストリとは別のレジストリが参照される動作となるため、この現象は発生しません。

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

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

Office 2016

Outlook 2016 のセキュリティ修正

2016 の Outlook のセキュリティ更新プログラムの説明: 2018 年 1 月 9日
1 件のセキュリティ修正と 2 件のセキュリティ以外の修正が行われています。

Office 2016 共通コンポーネントのセキュリティ修正

2016 の Office のセキュリティ更新プログラムの説明: 2018 年 1 月 9日
1 件の Outlook 2016 に関する修正が行われています。

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

2016 (KB4011625) の Office の更新プログラムを 2018 年 1 月 2日
1 件の Outlook 2016 に関する修正が行われています。

2016 (KB4011630) の Office の更新プログラムを 2018 年 1 月 2日
1 件の Outlook 2016 に関する修正が行われています。

2016 (KB4011659) の Office の更新プログラムを 2018 年 1 月 2日
1 件の Outlook 2016 に関する修正が行われています。

Word 2016 のセキュリティ修正

2016 の Word のセキュリティ更新プログラムの説明: 2018 年 1 月 9日
1 件の Outlook 2016 に関するセキュリティ修正が行われています。

Office 2013

Outlook 2013 のセキュリティ修正

Outlook 2013 のセキュリティ更新プログラムの説明: 2018 年 1 月 9日
1 件のセキュリティ修正と 2 件のセキュリティ以外の修正が行われています。

Word 2013 のセキュリティ修正

Word 2013 のセキュリティ更新プログラムの説明: 2018 年 1 月 9日
1 件の Outlook 2013 に関するセキュリティ修正が行われています。

Office 2010

Outlook 2010 のセキュリティ修正

Outlook 2010 用のセキュリティ更新プログラムの説明: 2018 年 1 月 9日
1 件のセキュリティ修正と 1 件のセキュリティ以外の修正が行われています。

Word 2010 のセキュリティ修正

Word 2010 のセキュリティ更新プログラムの説明: 2018 年 1 月 9日
1 件の Outlook 2010 に関するセキュリティ修正が行われています。

Office 2007

Outlook 2007 のセキュリティ修正

Outlook 2007 用のセキュリティ更新プログラムの説明: 2018 年 1 月 9日
1 件のセキュリティ修正が行われています。

Word 2007 のセキュリティ修正

Word 2007 セキュリティ更新プログラムの説明: 2018 年 1 月 9日
1 件の Outlook 2007 に関するセキュリティ修正が行われています。

11周年

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

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

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