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

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

Office 2016

Outlook 2016 の修正

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

Word 2016 の修正

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

Office 2016 の修正

2018 年 10 月 2日更新プログラム Office 2016 (KB4461442)
こちらは 10/2 にリリースされたものですが、1 件の Outlook に関する不具合の修正が行われています。

Office 2013

Outlook 2013 の修正

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

Office 2010

Outlook 2010 の修正

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

広告

共有メールボックスの受信トレイのメールを Excel ファイルにエクスポートするマクロ

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


共有メールフォルダに受信したメールをエクセルに書き出したい

outlookで個人アドレスの他に2つの共有アドレスを
使用しておりそれぞれのShared Mailboxに受信したメールをいちいち検索しなければいけない業務があります。
  個人の受信フォルダーにあるメールのエクセルへの
書き出しマクロは見かけるのですが共有フォルダのものは見つけられません、
またそれらを参考に自作を試みたもののシステムエラー続きでお手上げです。
  受信時間、送信者、件名、本文(全文は不要)をエクセルに書き出すマクロを教えてください。


共有メールボックスの受信トレイを取得するには NameSpace オブジェクトの GetSharedDefaultFolder メソッドを使用します。
このメソッドで取得した Folder オブジェクトの Items に含まれるすべてのアイテムについて Excel ファイルへ受信日時などをエクスポートすればご要望は満たせるでしょう。

マクロは以下のようになります。

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

Public Sub ExportInboxInSharedMailboxToExcel()
     ' 共有メールボックスのメールアドレスを指定
     Const SHARED_MAILBOX = "shared1@example.com"
     ' Excel ファイルのファイル名を指定
     Const EXCEL_FILE = "c:\temp\sharedmail.xlsx"
     ' Excel ファイルに書き出す本文の最大文字数
     Const MAX_BODY_CHARS = 250
     '
     Dim recOther As Recipient
     Dim fldOtherInbox As Folder
     Dim objBook
     Dim objSheet
     Dim objItem 'As MailItem
     Dim r As Integer
     ' 共有メールボックスの受信トレイを開く
     Set recOther = Session.CreateRecipient(SHARED_MAILBOX)
     Set fldOtherInbox = Session.GetSharedDefaultFolder(recOther, olFolderInbox)
     ' 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
     ' 共有メールボックスの受信トレイのすべてのアイテムについて処理
     For Each objItem In fldOtherInbox.Items
         ' メールの情報を Excel ファイルに追記
         With objSheet
             .Cells(r, 1) = objItem.ReceivedTime
             ' 差出人の名前にアドレスが含まれない場合のみアドレスを追加
             If InStr(objItem.SenderName, objItem.SenderEmailAddress) = 0 Then
                 .Cells(r, 2) = objItem.SenderName & _
                     " <" & objItem.SenderEmailAddress & ">"
             Else
                 .Cells(r, 2) = objItem.SenderName
             End If
             .Cells(r, 3) = objItem.Subject
             .Cells(r, 4) = Left(objItem.Body, MAX_BODY_CHARS)
         End With
         r = r + 1
     Next
     ' Excel ファイルを閉じる
     objBook.Close True
End Sub

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

Outlook 2019 の新機能

9/25 に Office 2019 が一般向けにリリースされ、10/5ました。

Office 2019 に含まれる Outlook 2019 の主な新機能としては以下のようなものがあります。

  • 優先受信トレイ
  • スケーラブル ベクター グラフィックス
  • ハンズフリー入力
  • 3 つ目のタイムゾーンの追加
  • メールの読み上げ
  • クラウド添付ファイルの自動ダウンロード

ただ、現在 Outlook 2016 を使われている方の中には、既に上記の機能を使っている、という人もいるかもしれません。
というのも、Office 2019 はこれまでの Office のバージョン アップとはちょっと異なるからです。

Office 2013 までは、Office のメジャー バージョン アップが 3-4 年に1度の割合で行われ、UI の変更や大掛かりな新機能の追加はメジャー バージョン アップで行われていました。

しかし、Office 2016 では、従来のインストール方式である MSI 版はこれまでと同じ方式 (機能追加なし) である一方、新しい C2R (Click-To-Run) 版では随時新機能が追加されるようになりました。
これは、日々新機能が追加されるクラウドやモバイルのスピード感に対応するための提供方法と思われます。
こうなってくると、メジャー バージョン アップはもはや不要と思われるのですが、問題は MSI 版を使用しているユーザーです。

MSI 版は C2R 版のように新機能が追加されないので、Office の進化に取り残されて行ってしまいます。
そこで、こうした MSI 版を使用しているユーザー向けに最新の Office 2016 の C2R 版を「Office 2019」として提供するというのが、今回のバージョン アップになります。
そのため、Office 2019 という名前ではありますが、ファイルのバージョン番号は 2016 と同じ 16.0 となっています。

Office 2016 の C2R 版の最新を切り出した形でリリースされているため、Office 2019 は C2R 版しか存在しないことになりますが、だからと言って今後 Office の C2R 版の一本化がされるというわけでもなさそうです。
というのも、もともと MSI 版を使用しているユーザーは新機能より安定性を求めており、UI の変更なども極力望んでいないと想定されるからです。
したがって、Office 2019 はリリース後は新機能の追加が凍結され、セキュリティ修正や重要な修正だけが行われるようなものになるでしょう。

メール送信時に配布グループを展開してアドレスを確認し、社外のアドレスへの送信で警告を表示するマクロ

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


はじめまして。
初心者ゆえ色々と参考にさせて頂き助かっております。
単純な質問で申し訳ありません。
Exchange環境でOutlook2016でメール送信時にメーリングリスト(グローバル配布先グループ)の
メンバーのSMTPアドレスを展開してメッセージ表示させるようにしたいのですが、
どうすれば良いのでしょうか。
グローバルの配布先グループに社外アドレスが含まれているものもあり、警告を出したいと
考えています。
ご教授のほど、宜しくお願い致します。


Exchange の配布グループについては Recipient オブジェクトの AddressEntry プロパティの GetExchangeDistributionList メソッドで ExchangeDistributionList オブジェクトとして取得可能です。
また、グループのメンバーは  ExchangeDistributionList オブジェクトの GetExchangeDistributionListMembers メソッドで AddressEntries として取得可能です。
これらのオブジェクトを使用してメンバーを展開することができます。
また、以前 Outlook の連絡先グループを展開するマクロについても「連絡先グループのメンバーを展開してメールアドレスを取得するマクロ」として作成していましたので、こちらの機能も追加しました。

マクロは以下の通りです。

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

'
Const MY_DOMAIN = "*@example.com" ' 自組織のドメイン名を指定。@ の前に * を付ける
Const REC_DELIMITER = "; " ' 複数受信者を表示する際の区切り文字
'
Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
     Dim objRec As Recipient
     Dim strSMTPAddr As String
     Dim strOut As String
     Dim iRet As Integer
     ' 組織外の受信者が存在するかどうかの確認
     bExternal = False
     strOut = ""
     For Each objRec In Item.Recipients
         ' 受信者の種類で判断
         Select Case objRec.AddressEntry.AddressEntryUserType
             Case olExchangeDistributionListAddressEntry
                 ' Exchange の配布グループの展開
                 ExpandExDistList objRec.AddressEntry, strOut
             Case olOutlookDistributionListAddressEntry
                 ' Outlook の連絡先グループの展開
                 ExpandOlContactGroup objRec, strOut
             Case Else
                 ' グループではない受信者
                 strSMTPAddr = GetSMTPAddr(objRec.AddressEntry)
                 If Not strSMTPAddr Like MY_DOMAIN Then
                     strOut = strOut & strSMTPAddr & REC_DELIMITER
                 End If
         End Select
     Next
     ' 組織外の受信者が含まれていた場合の処理
     If strOut <> "" 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(objAddrEntry As AddressEntry)
     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 objAddrEntry.Type = "SMTP" Then
         strSMTPAddr = objAddrEntry.Address
     Else ' Exchange 対応
         If objAddrEntry.AddressEntryUserType = olOutlookContactAddressEntry Then
             strSMTPAddr = objAddrEntry.PropertyAccessor.GetProperty(PR_ORIGINAL_DISPLAY_NAME)
         Else
             strSMTPAddr = objAddrEntry.PropertyAccessor.GetProperty(PR_SMTP_ADDRESS)
         End If
     End If
     GetSMTPAddr = strSMTPAddr
End Function
' Exchange 配布グループを展開するサブ プロシージャ
Private Sub ExpandExDistList(objExchDL As AddressEntry, ByRef strOut As String, Optional ByVal strExpanded As String = "")
     Const PR_SMTP_ADDRESS = "http:" & "//schemas.microsoft.com/mapi/proptag/0x39fe001e"
     Dim objExDistList As ExchangeDistributionList
     Dim colMembers As AddressEntries
     Dim objMember As AddressEntry
     Dim strSMTPAddr As String
     '
     If InStr(strExpanded, objExchDL.ID & ";") > 0 Then
         Exit Sub    ' 展開済みのグループは展開しない
     End If
     strExpanded = strExpanded & objExchDL.ID & ";"
     ' Exchange 配布グループ オブジェクトを取得
     Set objExDistList = objExchDL.GetExchangeDistributionList
     ' 配布グループのメンバーを取得
     Set colMembers = objExDistList.GetExchangeDistributionListMembers
     ' メンバーごとに処理
     For Each objMember In colMembers
         If objMember.AddressEntryUserType = olExchangeDistributionListAddressEntry Then
             ' メンバーが配布グループなら再帰して展開
             ExpandExDistList objMember, strOut, strExpanded
         Else
             ' メンバーの SMTP アドレスを取得
             strSMTPAddr = GetSMTPAddr(objMember)
             ' メンバーのアドレスが社外なら社外リストに追加
             If Not strSMTPAddr Like MY_DOMAIN Then
                 strOut = strOut & strSMTPAddr & REC_DELIMITER
             End If
         End If
     Next
End Sub
' Outlook の連絡先グループを展開するサブ プロシージャ
Private Sub ExpandOlContactGroup(objRec As Recipient, ByRef strOut As String, Optional ByVal strExpanded As String = "")
     Dim strCbLo As String
     Dim strCbHi As String
     Dim iCb As Integer
     Dim strEntryID As String
     Dim distList As DistListItem
     Dim objMember As Recipient
     Dim strSMTPAddr As String
     Dim i
     '
     If strExpanded = "" Then ' 展開済みのグループがない = トップのグループ
         ' 65 文字目からの 4 文字がエントリー ID の長さ
         strCbLo = Mid(objRec.AddressEntry.ID, 65, 2)
         strCbHi = Mid(objRec.AddressEntry.ID, 67, 2)
         iCb = Val("&H" & strCbHi & strCbLo)
         ' 73 文字目からがアイテムのエントリー ID
         strEntryID = Mid(objRec.AddressEntry.ID, 73, iCb * 2)
         Set distList = Session.GetItemFromID(strEntryID)
     Else ' 入れ子になっているグループの場合は 43 文字目からがアイテムのエントリー ID
         strEntryID = Mid(objRec.AddressEntry.ID, 43)
     End If
     '
     If InStr(strExpanded, strEntryID) > 0 Then
         Exit Sub      ' 展開済みのグループは展開しない
     End If
     strExpanded = strExpanded & strEntryID & ";"
     ' 連絡先グループ オブジェクトを取得
     Set distList = Session.GetItemFromID(strEntryID)
     ' メンバーごとに処理
     For i = 1 To distList.MemberCount
         Set objMember = distList.GetMember(i)
         If objMember.Address = "Unknown" Then
          ' メンバーが配布グループなら再帰して展開
             ExpandOlContactGroup objMember, strOut, strExpanded
         Else
             ' メンバーの SMTP アドレスを取得
             strSMTPAddr = GetSMTPAddr(objMember.AddressEntry)
             ' メンバーのアドレスが社外なら社外リストに追加
             If Not objMember.Address Like MY_DOMAIN Then
                 strOut = strOut & objMember.Address & REC_DELIMITER
             End If
         End If
     Next
End Sub

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

メールの本文で選択されたキーワードを指定したコードページでエンコードして Web で検索するマクロ

メールの本文で選択されたキーワードを Web で検索するマクロのコメントにて以下のご要望をいただきました。


上記マクロをカスタムしてみたいのですが、各検索の引数の値を文字コードを指定してURLエンコードしたいのですが可能でしょうか?


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

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

' コードページ変換の API を定義
Private Declare PtrSafe Function WideCharToMultiByte Lib "kernel32.dll" ( _
     ByVal CodePage As Long, _
     ByVal dwFlags As Long, _
     ByVal lpWideCharStr As LongPtr, _
     ByVal cchWideChar As Long, _
     ByVal lpMultiByteStr As LongPtr, _
     ByVal cchMultiByte As Long, _
     ByVal lpDefaultChar As LongPtr, _
     ByVal lpUsedDefaultChar As Long) As Long
' コードページの定数
Private Const CP_UTF8 As Long = 65001
Private Const CP_SJIS As Long = 932
'
' UTF-8 で Google 検索を行うマクロ
Public Sub GoogleSearchUTF8()
     WebSearchWithCP "https://www.google.co.jp/search?q=", CP_UTF8
End Sub
' Shift-JIS で Google 検索を行うマクロ
Public Sub GoogleSearchSJIS()
     WebSearchWithCP "https://www.google.co.jp/search?q=", CP_SJIS
End Sub
' コードページ指定で検索を実行する共通マクロ
Private Sub WebSearchWithCP(strCmd As String, lCodePage As Long)
     Dim objDoc As Object ' Word.Document
     Dim strKey As String
     Dim objShell As Object
     Dim lBufSize As Long
     Dim abBuf() As Byte
     Dim i As Integer
     Dim strHex As String
     ' 選択された文字列を取得
     Set objDoc = ActiveInspector.WordEditor
     strKey = Trim(objDoc.Application.Selection.Text)
     ' 文字列を指定されたコードページに変換した際のバイト数を取得
     lBufSize = WideCharToMultiByte(lCodePage, 0, StrPtr(strKey), Len(strKey), 0, 0, 0, 0)
     ' 必要なサイズにバッファを設定
     ReDim abBuf(lBufSize)
     ' 文字列を指定されたコードページに変換
     WideCharToMultiByte lCodePage, 0, StrPtr(strKey), Len(strKey), VarPtr(abBuf(0)), lBufSize, 0, 0
     ' 変換されたバイト配列を %xx の形式に変換
     strKey = ""
     For i = 0 To lBufSize - 1
         strHex = Right("0" & Hex(abBuf(i)), 2)
         strKey = strKey & "%" & strHex
     Next
     ' 取得した文字列を引数に追加して実行
     Set objShell = CreateObject("WScript.Shell")
     objShell.Run strCmd & strKey
End Sub

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

フォルダーに含まれるメールに添付されている PDF をすべて印刷するマクロ

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


こんばんわ。
特定の受信トレイに仕分けされたメールの添付ファイル(pdf)を、指定のプリンタで自動で印刷する方法を教えて頂きたいです(今は日に150-200件のメールの添付ファイルを、右クリック⇒印刷して対応しています)。
よろしくお願い致します。

OS:windows7 office2013


以前、仕訳ルールでメールの本文と PDF のみ印刷するマクロとして公開したマクロを応用すると、特定のフォルダーにあるすべてのメールの PDF ファイルを印刷することができます。
マクロは以下のようになります。
なお、このマクロで印刷のために保存された PDF ファイルは自動では削除されないので、必要に応じて手動で削除してください。

' ここをトリプルクリックでマクロ全体を選択できます。
' 以下はソースの先頭に記載する必要があります。
Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" _
                 (ByVal hwnd As Long, ByVal lpszOp As String, _
                  ByVal lpszFile As String, ByVal lpszParams As String, _
                  ByVal LpszDir As String, ByVal FsShowCmd As Long) _
                  As Long
'
Public Sub PrintAllPDFInCurrentFolder()
     Dim fldCurrent As Folder
     Dim objItem As Object '
     ' 現在選択されているフォルダーを取得
     Set fldCurrent = ActiveExplorer.CurrentFolder
     For Each objItem In fldCurrent.Items
         ' アイテムがメールだった場合だけ印刷
         If TypeName(objItem) = "MailItem" Then
             PrintPDFAttach objItem
         End If
     Next
End Sub
'
Private Sub PrintPDFAttach(ByVal objItem As MailItem)
     On Error Resume Next
     Const ATTACH_PATH = "c:\temp\" ' 添付ファイルを保存するフォルダー
     Dim objAttach As Attachment
     Dim strFileName As String
     Dim c As Integer
     ' 添付ファイルの印刷
     Dim objFSO 'As FileSystemObject
     Set objFSO = CreateObject("Scripting.FileSystemObject")
     For Each objAttach In objItem.Attachments
         If LCase(objAttach.FileName) Like "*.pdf" Then
             ' ファイルが PDF の場合のみ保存して印刷
             c = 1
             With objAttach
                 strFileName = .FileName
                 While objFSO.FileExists(ATTACH_PATH & strFileName)
                     strFileName = Left(.FileName, InStrRev(.FileName, ".") - 1) _
                         & "-" & c & Mid(.FileName, InStrRev(.FileName, "."))
                     c = c + 1
                 Wend
                 .SaveAsFile ATTACH_PATH & strFileName
             End With
             '    保存したファイルを印刷する
             ShellExecute 0, "print", ATTACH_PATH & strFileName, 0, ATTACH_PATH, 0
         End If
     Next
End Sub

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

Outlook 2016/Office 2013 の累積的な修正プログラム 2018 年 9 月分がリリース

9/4 に Outlook 2016 および Office 2013 の累積的な修正プログラムがリリースされました。

以下は各製品のそれぞれの KB へのリンクです。

Office 2016

Outlook 2016 の修正

2018 年 9 月 4日更新プログラム Outlook 2016 (KB4092462)
4 件の不具合修正が行われています。

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

2018 年 9 月 4日更新プログラム Office 2016 (KB4032237)
1 件の Outlook に関する不具合の修正が行われています。

Office 2013

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

2018 年 9 月 4日更新プログラム Office 2013 (KB4092469)
1 件の Outlook に関する不具合の修正が行われています。