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

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

Office 2016

Outlook 2016 のセキュリティ修正

Outlook 2016 セキュリティ更新プログラムについて2017 年 9 月 12 日
1 件のセキュリティ修正と 8 件のセキュリティ以外の修正が行われています。

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

2017 年 9 月 5日で、更新プログラム Office 2016 (KB3191923)
1 件の Outlook 2016 に関する修正が行われています。

2017 年 8 月 22日、更新プログラム Office 2016 (KB4011093)
1 件の Outlook 2016 に関する修正が行われています。

Word 2016 の修正

2017 年 9 月 5日を Word 2016 (KB4011039) の更新します。
1 件の Outlook 2016 に関する修正が行われています。

Office 2013

Outlook 2013 のセキュリティ修正

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

Office 2010

Outlook 2010 のセキュリティ修正

Outlook 2010 セキュリティ更新プログラムについて2017 年 9 月 12 日
1 件のセキュリティ修正が行われています。

Office 2007

Outlook 2007 のセキュリティ修正

Outlook 2007 セキュリティ更新プログラムについて2017 年 9 月 12 日
1 件のセキュリティ修正が行われています。

広告

メッセージ受信時に游ゴシックを別のフォントに置き換えるマクロ

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


コメント失礼します。

Windows10でoutlook2016を使用しております。

游ゴシックを使用したHTMLメールが大変読みにくく(Outlook2016のデフォルトでしょうか…)

画面の調整では限度あり、かすれたような読みにくさは、

PCの環境によっては、回避できない場合もあります。

Outlookの設定では、HTMLメールをテキスト形式として受信する設定があり、

かつ、テキストメールの設定を所望のフォントにしておけば、

見やすさは確保できるのですが、

余計な改行が入る、表などの書式もなくなってしまうことから

この機能に頼ることはできません。

そもそも、

HTMLメールに游ゴシックを使わない、(好きな方ゴメンナサイ。)

HTMLメールで改行するときは、SHIFT+ENTERで!

と送信時に、ひと手間かけていただければ解決するのですが、

それはそれで、難しい話です。

ご提案なのですが、

HTMLメール受信時に、特定のフォント(游ゴシック)を、

特定のフォント(MeiryoUIやMSゴシック)に置換し

表示するマクロがあると、救われる方々が大勢いらっしゃると思います。

是非、ご一考いただければ幸いです。


メッセージ受信時に発生する NewMailEx イベントで HTML 本文を保持する HTMLBody プロパティ内のフォントの文字列を Replace 関数で置き換えれば実現は可能です。

ただし、HTMLBody の文字列を丸ごと一括置換してしまうと、フォント指定ではなく本文の文面として「游ゴシック」という言葉を使ったときにも置き換えられてしまいます。
そのため、HTML のタグの中だけを置き換えるという処理が必要となります。

実装は以下のようになります。

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

Private Sub Application_NewMailEx(ByVal EntryIDCollection As String)
     On Error GoTo END_OF_EVENT
     Const YU_GOTHIC1 = "游ゴシック"
     Const YU_GOTHIC2 = "Yu Gothic"
     Const DEFAULT_FONT = "Meiryo UI"
     Dim objItem As MailItem
     Dim strOldHTML As String
     Dim strNewHTML As String
     Dim iHeader As Integer
     Dim iStart As Integer
     Dim iEnd As Integer
     Dim strHeader As String
     Dim strTag As String
     ' 受信アイテムを取得
     Set objItem = Session.GetItemFromID(EntryIDCollection)
     ' HTML 形式の場合のみ処理
     If objItem.BodyFormat = olFormatHTML Then
         strOldHTML = objItem.HTMLBody
         ' ヘッダー部分の取得
         iHeader = InStr(1, strOldHTML, "</head>", vbTextCompare)
         If iHeader > 0 Then
             ' ヘッダー内のフォント記述は一括置換
             strHeader = Left(strOldHTML, iHeader - 1)
             strHeader = Replace(strHeader, YU_GOTHIC1, DEFAULT_FONT)
             strHeader = Replace(strHeader, YU_GOTHIC2, DEFAULT_FONT)
             strOldHTML = Mid(strOldHTML, iHeader)
             ' 置き換えたヘッダーをコピー
             strNewHTML = strHeader
         Else
             strNewHTML = ""
         End If
         '
         iEnd = 0
         ' タグの始まりを検索
         iStart = InStr(1, strOldHTML, "<")
         While iStart > 0 ' タグが存在する間繰り返す
             ' タグの終わりまではそのままコピー
             strNewHTML = strNewHTML & Mid(strOldHTML, iEnd + 1, iStart - iEnd - 1)
             ' タグの終わりを検索
             iEnd = InStr(iStart, strOldHTML, ">")
             ' タグ文字列を取得
             strTag = Mid(strOldHTML, iStart, iEnd - iStart + 1)
             ' タグ文字列内のフォントを置換
             strTag = Replace(strTag, YU_GOTHIC1, DEFAULT_FONT)
             strTag = Replace(strTag, YU_GOTHIC2, DEFAULT_FONT)
             ' 置き換えたタグをコピー
             strNewHTML = strNewHTML & strTag
             ' タグの始まりを検索
             iStart = InStr(iEnd + 1, strOldHTML, "<")
         Wend
         ' 最後のタグの後に文字列があれば追加し、HTML 本文を置き換え
         objItem.HTMLBody = strNewHTML & Mid(strOldHTML, iEnd + 1)
         ' アイテムを保存
         objItem.Save
     End If
END_OF_EVENT:
End Sub

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

複数フォルダーに格納されている特定の件名のメールの情報を Excel ファイルにエクスポートするマクロ

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


いつもブログ拝見させていただいています。

私は、ある会社で新人研修のスタッフを行っております。
  新入社員は一日の終わりに日報をメールで作成して送るのが義務に
  なっています。

そこで新入社員が送信したメールデータをExcelファイルにエクスポートする
  マクロはございますでしょうか。
  (新入社員が日報を送ったかチェックするためです。)

■メール抽出条件
・件名が”【日報】”となっているもの
  ・日付を指定して抽出する
  ・受信フォルダを複数指定して抽出

■Excelに抽出する際に必要情報な情報
・件名
・差出人(CC情報も含む)
・宛先

利用環境はOutlook2016です。

ご教授頂きたく、宜しくお願い致します。


「フォルダを複数指定して抽出」という処理をマクロで実装する場合、配列などにフォルダーのパスを指定しておき、フォルダーごとに抽出処理を行う必要があります。
また、パスからフォルダーを取得するということ自体もちょっと面倒なのですが、この処理は GetFolderByPath という関数で実装しています。
Excel に抽出する際に必要な情報にフォルダーがなかったのですが、フォルダーも必要なのではないかと思ったので追加しています。
マクロは以下の通りです。

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

Public Sub ExportDailyReport()
     Const SUBJECT_PATTERN = "【日報】*"
     Dim dtExport As String
     Dim arrExportFolder As Variant
     Dim i As Integer
     Dim iRow As Integer
     Dim appExcel As Object
     Dim objBook As Object
     Dim objSheet As Object
     Dim fldExport As Folder
     Dim colItems As Items
     Dim itmReport As Variant ' MailItem
     ' フォルダーを "" でくくって指定します
     arrExportFolder = Array("受信トレイ", "受信トレイ\Sub1", "Root1")
     dtExport = Now
     'dtExport = DateAdd("d", -1, Now) ' 既定の日付を昨日にする場合はこちら
     dtExport = InputBox("エクスポートする日付を入力してください", _
         "日付の入力", FormatDateTime(dtExport, vbShortDate))
     '
     ' Excel ワークシートの準備
     Set appExcel = CreateObject("Excel.Application")
     Set objBook = appExcel.Workbooks.Add()
     Set objSheet = objBook.Sheets(1)
     objSheet.cells(1, 1) = "件名"
     objSheet.cells(1, 2) = "差出人"
     objSheet.cells(1, 3) = "宛先"
     objSheet.cells(1, 4) = "Cc"
     objSheet.cells(1, 5) = "フォルダー"
     iRow = 2
     ' フォルダーごとにエクスポート処理
     For i = LBound(arrExportFolder) To UBound(arrExportFolder)
         ' フォルダーを取得
         Set fldExport = GetFolderByPath(arrExportFolder(i))
         Set colItems = fldExport.Items
         ' 受信日時でアイテムを検索
         Set itmReport = colItems.Find("[受信日時] >= '" & dtExport & " 00:00' and [受信日時] < '" _
             & DateAdd("d", 1, dtExport) & " 00:00'")
         While Not itmReport Is Nothing
             ' 件名がパターンと合致したらアイテムの情報を書き出す
             If itmReport.Subject Like SUBJECT_PATTERN Then
                 With itmReport
                     objSheet.cells(iRow, 1) = .Subject
                     objSheet.cells(iRow, 2) = .SenderName
                     objSheet.cells(iRow, 3) = .To
                     objSheet.cells(iRow, 4) = .CC
                     objSheet.cells(iRow, 5) = arrExportFolder(i)
                     iRow = iRow + 1
                 End With
             End If
             Set itmReport = colItems.FindNext
         Wend
     Next
     ' Excel ファイルの表示
     appExcel.Visible = True
     objBook.windows(1).Visible = True
End Sub
'
' パスからフォルダーを取得する関数
'
Private Function GetFolderByPath(ByVal strPath As String) As Folder
     Dim fldRoot As Folder
     ' 既定のメール ストアのルートを取得
     Set fldRoot = Session.DefaultStore.GetRootFolder
     ' パスに \ を含まなければルート直下のフォルダーを取得
     If InStr(strPath, "\") = 0 Then
         Set GetFolderByPath = fldRoot.Folders(strPath)
     Else
         Dim arrPath As Variant
         Dim fldSub As Folder
         Dim i As Integer
         ' パスを \ で分割
         arrPath = Split(strPath, "\")
         ' 分割したパスをたどってフォルダーを取得
         For i = LBound(arrPath) To UBound(arrPath)
             Set fldSub = fldRoot.Folders(arrPath(i))
             Set fldRoot = fldSub
         Next
         Set GetFolderByPath = fldSub
     End If
End Function

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

特定の条件のメールを受信した際に、本文に記載された 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 の既知の問題