他のユーザーの予定表を非公開のものも含めて CSV ファイルにエクスポートするマクロ

Outlook の予定表を CSV ファイルにエクスポートするマクロ Ver 2 のコメントにて以下のご要望をいただきました。


はじめまして。
  他メンバーのスケジュール書き出しに便利に使わせて頂いています。
  以下の方法をご教示いただけないでしょうか。
1.非公開の予定を「非公開」の予定として書き出す方法。
2.空の予定を書きださない方法。
どうかよろしくお願い申し上げます。


まず、2 については AppointmentItemBusyStatus に公開方法が格納されていますので、こちらが olFree である予定を除外することで空き時間となっている予定を書き出さないようにすることができます。

問題は、1 についてです。
他のユーザーの非公開の予定については、Outlook Object Model では AppointmentItem オブジェクトとして取得ができません。
取得ができないということは、存在すらわからないということになります。
しかし、Exchange Web Service (EWS) というインターフェイスにより Exchange サーバーの可用性サービスから空き時間情報を取得すると、非公開の予定の情報も取得できます。
「空き時間情報、件名、場所」の権限がある他のユーザーの予定を CSV にエクスポートするマクロとして EWS でアクセスする方法も公開していますが、こちらの方法だと取得できる情報が件名や場所に限られるため、非公開以外の予定は Outlook Object Model、非公開の予定は EWS で取得することで、ご要望は満たせるかと思います。

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

' ここをトリプルクリックでマクロ全体を選択できます。
'  他人の予定を出力するマクロ
Public Sub ExportOthersCalendar()
     Const OTHERS_CSV_FILE_NAME = "c:\temp\others.csv" ' エクスポートするファイル名を指定してください。
     Dim strUserName As String
     Dim objRecip As Recipient
     Dim objExchUser As ExchangeUser
     Dim fldCalendar As Folder
     Dim strStart As String
     Dim strEnd As String
     Dim dtExport As Date
     Dim objFSO 'As FileSystemObject
     Dim stmCSVFile 'As TextStream
     Dim colAppts As Items
     Dim objAppt As AppointmentItem
     Dim strLine As String
     Dim xmlDoc As Variant
     Dim arrFBResps As Variant
     Dim i, j As Integer
     '
     strUserName = InputBox("ユーザー名またはアドレスを入力してください", "共有されている予定表のエクスポート")
     '
     Set objRecip = Session.CreateRecipient(strUserName)
     objRecip.Resolve
     If Not objRecip.Resolved Then
         MsgBox "ユーザーが特定できませんでした。", vbCritical, "共有されている予定表のエクスポート"
         Exit Sub
     End If
     '
     dtExport = Now ' 来月の予定をエクスポートする場合は Now の代わりに DateAdd("m",1,Now) を使用します。
     ' 月単位ではなく任意の単位にする場合は以下の記述を変更します。
     strStart = Year(Now) & "/" & Month(Now) & "/1 00:00"
     strEnd = DateAdd("m", 1, CDate(strStart)) & " 00:00"
     '
     Set objFSO = CreateObject("Scripting.FileSystemObject")
     Set stmCSVFile = objFSO.CreateTextFile(OTHERS_CSV_FILE_NAME, True)
     ' CSV ファイルのヘッダです。出力するフィールドを増減する場合はこちらも変更してください。
     stmCSVFile.WriteLine """件名"",""場所"",""開始日"",""開始時刻"",""終了日""," & _
         """終了時刻"",""分類項目"",""主催者"",""必須出席者"",""任意出席者"""
     ' フェーズ 1: 予定表フォルダーから出力
     Set fldCalendar = Session.GetSharedDefaultFolder(objRecip, olFolderCalendar)
     Set colAppts = fldCalendar.Items
     colAppts.Sort "[開始日]"
     colAppts.IncludeRecurrences = True
     Set objAppt = colAppts.Find("[開始日] < """ & strEnd & """ AND [終了日] >= """ & strStart & """")
     While Not objAppt Is Nothing
         ' 公開方法が空きでなければ出力
         If objAppt.BusyStatus <> olFree Then
             strLine = """" & objAppt.Subject & _
                 """,""" & objAppt.Location & _
                 """,""" & FormatDateTime(objAppt.Start, vbShortDate) & _
                 """,""" & FormatDateTime(objAppt.Start, vbShortTime) & _
                 """,""" & FormatDateTime(objAppt.End, vbShortDate) & _
                 """,""" & FormatDateTime(objAppt.End, vbShortTime) & _
                 """,""" & objAppt.Categories & _
                 """,""" & objAppt.Organizer & _
                 """,""" & objAppt.RequiredAttendees & _
                 """,""" & objAppt.OptionalAttendees & _
                 """"
             stmCSVFile.WriteLine strLine
         End If
         Set objAppt = colAppts.FindNext
     Wend
     ' フェーズ 2: 空き時間情報から出力
     Set xmlDoc = Nothing
     ' SMTP アドレスを取得するために ExchangeUser オブジェクトを取得
     Set objExchUser = objRecip.AddressEntry.GetExchangeUser
     ' Exchange サーバーの可用性サービスから空き時間を取得
     GetUsersAvailability objExchUser.PrimarySmtpAddress, strStart, strEnd, xmlDoc
     If Not xmlDoc Is Nothing Then
         ' 取得した空き時間を配列に設定
         Set arrFBResps = xmlDoc.DocumentElement.getElementsByTagName("FreeBusyResponse")
         For i = 0 To arrFBResps.Length - 1
             ' 取得が成功したか確認
             If arrFBResps(i).getElementsByTagName("ResponseMessage").Item(0).Attributes.getNamedItem("ResponseClass").Text = "Success" Then
                 Dim arrCalEvents As Variant
                 Dim calEvent As Variant
                 Dim strStatus As String
                 Dim strIsPrivate As String
                 Dim dtCalStart As Date
                 Dim dtCalEnd As Date
                 ' 予定を一つずつ処理
                 Set arrCalEvents = arrFBResps(i).getElementsByTagName("CalendarEvent")
                 For j = 0 To arrCalEvents.Length - 1
                     Set calEvent = arrCalEvents(j)
                     strIsPrivate = GetValue(calEvent, "IsPrivate")
                     strStatus = GetValue(calEvent, "BusyType")
                     ' 非公開の予定、かつ公開方法が空きでなければ出力
                     If strIsPrivate = "true" And strStatus <> "Free" Then
                         dtCalStart = GetDateValue(calEvent, "StartTime")
                         dtCalEnd = GetDateValue(calEvent, "EndTime")
                         strLine = """非公開の予定"",""" & _
                             """,""" & FormatDateTime(dtCalStart, vbShortDate) & _
                             """,""" & FormatDateTime(dtCalStart, vbShortTime) & _
                             """,""" & FormatDateTime(dtCalEnd, vbShortDate) & _
                             """,""" & FormatDateTime(dtCalEnd, vbShortTime) & _
                             """"
                         stmCSVFile.WriteLine strLine
                     End If
                 Next
             End If
         Next
     End If
     stmCSVFile.Close
End Sub
'
'  Exchange サーバーの可用性サービスから空き時間を取得するサブ プロシージャ
Sub GetUsersAvailability(strAddress As String, strStart As String, strEnd As String, xmlDoc As Variant)
     Const EWS_URL = "http:" & "//casserver.example.com/ews/exchange.asmx" ' EWS の URL を指定します。
     Const W3_ORG = "http:" & "//www.w3.org"
     Const SOAP_SCHEMAS = "http:" & "//schemas.xmlsoap.org"
     Const MS_SCHEMAS = "http:" & "//schemas.microsoft.com"
     Dim xmlHttp
     Dim strXmlData As Variant
     Dim i As Integer
     ' EWS リクエスト生成
     Set xmlHttp = CreateObject("MSXML2.XMLHTTP")
     strXmlData = "<?xml version=""1.0"" encoding=""utf-8""?>" & _
         "<soap:Envelope xmlns:xsi=""" & W3_ORG & "/2001/XMLSchema-instance""" & _
         " xmlns:xsd=""" & W3_ORG & "/2001/XMLSchema""" & _
         " xmlns:soap=""" & SOAP_SCHEMAS & "/soap/envelope/""" & _
         " xmlns:t=""" & MS_SCHEMAS & "/exchange/services/2006/types"">" & _
         "<soap:Body>" & _
         "<GetUserAvailabilityRequest xmlns=""" & MS_SCHEMAS & "/exchange/services/2006/messages""" & _
         " xmlns:t=""" & MS_SCHEMAS & "/exchange/services/2006/types"">" & _
         "<t:TimeZone xmlns=""" & MS_SCHEMAS & "/exchange/services/2006/types"">" & _
         "<Bias>-540</Bias>" & _
         "<StandardTime><Bias>0</Bias><Time>00:00:00</Time><DayOrder>0</DayOrder>" & _
          "<Month>0</Month><DayOfWeek>Sunday</DayOfWeek></StandardTime>" & _
         "<DaylightTime><Bias>-60</Bias><Time>00:00:00</Time><DayOrder>0</DayOrder>" & _
          "<Month>0</Month><DayOfWeek>Sunday</DayOfWeek></DaylightTime>" & _
         "</t:TimeZone>" & _
         "<MailboxDataArray>"
     ' 取得するメールボックスを追加
     strXmlData = strXmlData & _
         "<t:MailboxData><t:Email><t:Address>" & strAddress & "</t:Address></t:Email>" & _
         "<t:AttendeeType>Required</t:AttendeeType><t:ExcludeConflicts>false</t:ExcludeConflicts>" & _
         "</t:MailboxData>"
     ' 取得する期間を設定
     strStart = Format(strStart, "yyyy-mm-ddThh:nn:ss")
     strEnd = Format(strEnd, "yyyy-mm-ddThh:nn:ss")
     ' その他の条件を設定
     strXmlData = strXmlData & _
         "</MailboxDataArray>" & _
         "<t:FreeBusyViewOptions>" & _
         "<t:TimeWindow>" & _
         "<t:StartTime>" & strStart & "</t:StartTime>" & _
         "<t:EndTime>" & strEnd & "</t:EndTime>" & _
         "</t:TimeWindow>" & _
         "<t:MergedFreeBusyIntervalInMinutes>60</t:MergedFreeBusyIntervalInMinutes>" & _
         "<t:RequestedView>DetailedMerged</t:RequestedView>" & _
         "</t:FreeBusyViewOptions>" & _
         "</GetUserAvailabilityRequest>" & _
         "</soap:Body>" & _
         "</soap:Envelope>"
     ' リクエスト送信
     xmlHttp.Open "POST", EWS_URL, False
     xmlHttp.setRequestHeader "Content-Type", "text/xml"
     xmlHttp.Send strXmlData
     If xmlHttp.Status = "200" Then
         Set xmlDoc = CreateObject("MSXML2.DOMDocument")
         Debug.Print xmlHttp.responseText
         If xmlDoc.LoadXML(xmlHttp.responseText) Then
             ' OK ならここで終了
             Exit Sub
         End If
     End If
     ' エラーなら Nothing を設定
     Set xmlDoc = Nothing
End Sub
'
Function GetValue(xmlNode, strName)
     On Error Resume Next
     Dim arrNodes
     Set arrNodes = xmlNode.getElementsByTagName(strName)
     If arrNodes.Length = 0 Then
         GetValue = ""
     Else
         GetValue = arrNodes(0).Text
     End If
End Function
'
Function GetDateValue(xmlNode, strName)
     On Error Resume Next
     Dim arrNodes
     Dim strDate
     Set arrNodes = xmlNode.getElementsByTagName(strName)
     If arrNodes.Length = 0 Then
         GetDateValue = ""
     Else
         strDate = arrNodes(0).Text
         strDate = Replace(strDate, "-", "/")
         strDate = Replace(strDate, "T", " ")
         GetDateValue = CDate(strDate)
     End If
End Function

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

広告

選択したフォルダーとそのサブフォルダーのすべてのアイテムを HTML ファイルとして連番付きで保存するマクロ

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


突然のコメントを失礼いたします。
  「選択したメッセージを MSG ファイルまたは RTF ファイルとして保存するマクロ」を拝見し、
  利用させていただきたいと思うのですが、
  同様の動作で、追加で下記を実現する方法をご教示いただけないでしょうか。
・受信トレイの下の、任意の複数フォルダを選択し、各フォルダ直下の全てのメールを、そのフォルダ階層を保持したまま、任意の保存先に保存する。
・メッセージをHTML形式で保存する。
お手数をおかけして申し訳ありませんが、お知恵を拝借いただけますと幸いです。
  以上、何卒よろしくお願いいたします。


何度も申し訳ありません。「選択したフォルダーとそのサブフォルダーのすべてのアイテムを MSG ファイルとして保存するマクロ」も参照したところ、 ‘ファイルをフォルダに保存 の箇所を、下記とすればHTML形式で保存ができました。大変失礼いたしました。
objItem.SaveAs strFileName & “.html”, olHTML
もう一点、実現できていないことが、メールの保存時に、各フォルダ内のメールの件名の頭に、受信時間が最も古いものから順に番号を付けたい(例:”1_XXXXX.html”、”2_XXXXX.html”…)という要件です。
もし、実現方法がありましたら、ご教示いただけますと幸いです。
以上、何卒よろしくお願いいたします。


受信時間が最も古いものから順に連番を付けるには、Items オブジェクトの Sort メソッドで受信日時により並べ替えを行い、その順番で連番を付与します。
マクロは以下のようになります。

' ここをトリプルクリックでマクロ全体を選択できます。
'
Sub SaveCurrentFolderAndSubToDiskHTML()
     Const SAVE_PATH = "c:\temp\" ' 保存するフォルダのパス。最後に必ず \ をつける
     SaveFolderRecursiveHTML ActiveExplorer.CurrentFolder, SAVE_PATH
End Sub
' フォルダーのアイテムを再帰的に保存するルーチン
Private Sub SaveFolderRecursiveHTML(objFolder As Folder, strSavePath As String)
     On Error Resume Next
     Dim colItems As Items
     Dim objItem 'As MailItem
     Dim strFileName As String
     Dim c As Integer
     Dim i As Integer
     Dim arrErrChars
     Dim objFSO
     Dim objSubFolder As Folder
     arrErrChars = Array("\", "/", ":", "*", "?", """", "<", ">", "|")
     ' アイテムを受信日時の古い順に並べ替える
     Set colItems = objFolder.Items
     colItems.Sort "[受信日時]", False
     ' 連番の初期値設定
     c = 1
     '
     For Each objItem In colItems
         ' ファイル名を件名から作成
         strFileName = c & "_" & objItem.Subject
         ' ファイル名として不適切な文字を _ に置き換える
         For i = 0 To UBound(arrErrChars)
             strFileName = Replace(strFileName, arrErrChars(i), "_")
         Next
         ' ファイル名が 260 文字を超えないようにする
         strFileName = Left(strSavePath & strFileName, 250)
         ' ファイルをフォルダに保存
         objItem.SaveAs strFileName & ".html", olHTML
         c = c + 1
     Next
     '
     Set objFSO = CreateObject("Scripting.FileSystemObject")
     ' サブフォルダーを保存
     For Each objSubFolder In objFolder.Folders
         ' ディスク上にフォルダーが存在しなければ作成する
         If Not objFSO.FolderExists(strSavePath & objSubFolder.Name) Then
             objFSO.CreateFolder strSavePath & objSubFolder.Name
         End If
         SaveFolderRecursiveHTML objSubFolder, strSavePath & objSubFolder.Name & "\"
     Next
End Sub

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

件名、本文、差出人が空白のメールをフォルダから削除するマクロ

件名、本文、差出人が空白のメールを受信時に削除するマクロのコメントにて以下のご要望をいただきました。


既に受信してしまった空白メールを纏めて削除する場合は、どのようにすればよいのでしょうか?


受信時に削除するマクロを設定する前に受信した空白メールについて削除するマクロは以下のようなものになります。

' ここをトリプルクリックでマクロ全体を選択できます。
Public Sub DeleteEmptyMail()
     Dim fldInbox As Folder
     Dim i As Integer
     ' 受信トレイの空白メールを削除する場合は以下の記述になります
     Set fldInbox = Session.GetDefaultFolder(olFolderInbox)
     ' 現在選択中のフォルダーの空白メールを削除する場合は以下の記述になります
     'Set fldInbox = ActiveExplorer.CurrentFolder
     '
     For i = fldInbox.Items.Count To 1 Step -1
         With fldInbox.Items(i)
             If .Subject = "" And .Body = "" And .SenderName = "" Then
                 .UnRead = False ' 既読にする
                 .Delete ' 削除する
             End If
         End With
     Next
End Sub

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

社外のアドレスを宛先に含む場合のみ BCC を追加するマクロ

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


Outlookで常に特定のメールアドレスを[Bcc:]に入れて送信するマクロを組みたいのですが、できれば加えて宛先が社外のメールのみという指定ができればと思っております。
  全送信メールに対して設定するマクロについては、検索で見つけることができ、設定して試してみたところ問題なく動作しました。
ただ、「社外メールのみ」という部分を検索で指定すると、自分の検索方法が悪いのかもしれないのですが、見つけることができず、こちらでコメントさせて頂いた次第です。当方、マクロなど素人につき、お教えいただけたら幸いです。どうぞ、よろしくお願い致します。

使用環境
Windows10
  office2016


宛先が社外のメールかどうかを判断するには、宛先のアドレスのドメインを確認する必要があります。
メールアドレスは Recipient オブジェクトの Address プロパティで確認できるのですが、Outlook.com に接続しているような場合は Address プロパティでは SMTP アドレスが取得できないこともあります。
そのため、アドレス取得のロジックは Exchange 環境下で組織外のアドレスに送信する際に警告を表示するマクロのものを流用しています。
マクロは以下の通りです。

' ここをトリプルクリックでマクロ全体を選択できます。
Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
     Const MY_DOMAIN = "*@example.com" ' 自組織のドメイン名を指定。@ の前に * を付ける
     Const BCC_ADDR = "bcc@example.com" ' BCC として追加するアドレス
     Dim objRec As Recipient
     Dim strSMTPAddr As String
     Dim bExternal As Boolean
     Dim recBcc As Recipient
     ' 組織外の受信者が存在するかどうかの確認
     bExternal = False
     For Each objRec In Item.Recipients
         strSMTPAddr = GetSMTPAddr(objRec)
         If Not strSMTPAddr Like MY_DOMAIN Then
             bExternal = True
             Exit For
         End If
     Next
     ' 組織外の受信者が複数含まれていた場合は BCC を追加
     If bExternal Then
         Set recBcc = Item.Recipients.Add(BCC_ADDR)
         recBcc.Type = olBCC
         recBcc.Resolve
         Item.Save
     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

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

2020 年の海の日、山の日および体育の日を移動するスクリプト

6 月 13 日に 2020 年の海の日、山の日および体育の日が東京オリンピックに合わせて移動されるという法律が可決、成立しました。

今後、この法律に基づいて更新された Outlook の祝日ファイルも更新プログラムとして提供されることになると思いますが、すでに延長サポート フェーズに入っている Outlook 2013 や Outlook 2010 には提供されない可能性があります。
また、Outlook 2016 でも、更新プログラムを適用すれば変更されるというわけではなく、いったん祝日を削除して改めて追加するという作業が必要になります。

そのようなわけで、祝日を移動するスクリプトを作ってみました。
スクリプトは以下の通りです。

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

Const olFolderCalendar = 9
Dim olkApp
Dim fldCal
' Outlook の予定表を取得
Set olkApp = CreateObject("Outlook.Application")
Set fldCal = olkApp.Session.GetDefaultFolder(olFolderCalendar)
' 祝日ごとに移動
MoveHoliday fldCal, "海の日", "7/20", "7/23"
MoveHoliday fldCal, "山の日", "8/11", "8/10"
MoveHoliday fldCal, "体育の日", "10/12", "7/24"
' 一つの祝日を移動するプロシージャ
Sub MoveHoliday(fldCal, strName, strStart, strNewStart)
     Dim apptHol
     ' 件名と日付により祝日を検索
     Set apptHol = fldCal.Items.Find("[件名]='" & strName & _
         "' And [開始日]='2020/" & strStart & " 00:00'")
     ' 見つかったら新しい日付に移動
     If Not apptHol Is Nothing Then
         apptHol.Start = CDate("2020/" & strNewStart)
         apptHol.Save
     End If
End Sub

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

6/12 に Outlook 2016、Outlook 2013 および Outlook 2010 のセキュリティ修正プログラムがリリースされました。

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

Office 2016

Outlook 2016 の修正

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

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

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

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

Office 2013

Outlook 2013 の修正

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

Office 2010

Outlook 2010 の修正

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

マクロの署名に必要な証明書

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


いつもお世話になっております。
マクロのセキュリティで証明書付きのマクロのみを有効にする設定でマクロを有効にする場合の証明書について教えていただけないでしょうか。当方ではPC利用環境毎に証明書が発行され認証にも使用されています。また、インストールソフトウェアの変更はポリシー上許可されておらずofficeのSELFCERT.EXEは未導入の状況です。以上のことから発行済みの証明書を使用してマクロを動作させたいと考えているのですが証明書選択画面で選択を押下しても有効な証明書はありませんと表示されます。マクロを動作させるための証明書について形式、証明書の種類、保存フォルダ等の制限についてどなたかご教示いただけないでしょうか。

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


マクロの署名に必要な証明書としては以下の要件を満たす必要があります。

  • 秘密鍵を保持する
  • 証明書の目的として [コード署名] を含む
  • Windows の証明書ストアに格納されている

上記の要件についてそれぞれ説明します。

秘密鍵を保持する

マクロの署名には公開鍵基盤 (PKI) が使用されており、この方式では以下の 2 つの鍵が必要となります。

秘密鍵: デジタル署名の署名作成と暗号化の解除に使用
公開鍵: デジタル署名の署名の確認と暗号化に使用

このうち、秘密鍵については極めて重要なものであるため、証明書の発行を依頼したユーザーにのみ秘密鍵を含む証明書が発行されます。

証明書の目的として [コード署名] を含む

一口に証明書といっても、その用途は以下の通り様々です。

  • サーバーの証明
  • クライアントの証明
  • S/MIME の署名、暗号化
  • 暗号化ファイル システム
  • コード署名

そして、証明書の目的が限定されている場合、それ以外の目的では証明書として使用することはできません。
マクロの署名を行うには [コード署名] に使用できる証明書が必要となるので、例えばクライアントの認証に使われる [クライアントの証明] の証明書があったとしても、マクロの署名には使用できません。
なお、証明書の目的は証明書の発行のタイミングで設定されるので、すでに発行されている証明書に目的を追加することはできません。

Windows の証明書ストアに格納されている

Outlook は証明書を Windows の証明書ストアから検索します。
そのため、証明書がファイルとして存在していても、それが参照されることはありません。
秘密鍵を保持する証明書がファイルとしてローカルにあるのであれば、それを証明書ストアにインストールする必要があります。
通常は、その証明書ファイルをダブルクリックすると証明書のインポート ウィザードが起動してインポートできます。
なお、この時パスワードが要求されない場合、その証明書には秘密鍵が入っていないと考えられます。

まとめ

証明書をどのような形で発行・取得されているのかが不明ですが、「コード署名証明書」や「コードサイニング証明書」というキーワードで検索すれば、ご使用になられている証明機関でのコード署名証明書の発行手順はわかると思います。