帯

VBA Outlookメール宛名書きメニュー化

のぶ

前回記事「VBA Outlookメール宛名書き」では、Outlookメールで宛名書きをする簡単なプログラムを作成しました。

今回はそのプログラムの機能を拡張します。アドレス情報に含まれる名前や所属、役職などの情報を組み合わせて様々なパターンの宛名を作成し、メニューで選べるようにします。また、Word機能を利用して宛名を書き込むことで、HTML形式やリッチテキスト形式のメールにも対応します。

ツールの使用イメージ

メッセージ編集ウィンドウで宛先やCCにアドレスを設定して、クイックアクセスツールバーのコマンド（Project1.WriteNameMenu）ボタンを押すと、「宛名書きメニュー」が表示されます。このメニューのボタン表示名は、送信先に設定したアドレス情報から動的に作成され、宛名のいくつかのフォーマットを選べるようになっています。

メニューで書き込みたいボタンを押すと、全てのアドレスが、その宛名フォーマットで作成され、メール文頭に書き込まれます。

モジュール構成

このツールプログラムは次の３つのモジュールで構成されます。
・ModuleWriteNameMenu.bas　メインモジュール（116行）
・MenuForm.frm  (.frx)　メニューのユーザーフォーム（57行）
・ClassMenuButton.cls　メニューボタンのクラスモジュール（12行）

プログラムのメイン関数

プログラム全体の動きを示すために、メインモジュールからメイン関数のコードを抜粋して次に記載します。

Public Sub WriteNameMenu()
    Dim oMailItem As MailItem: Set oMailItem = Application.ActiveInspector.CurrentItem
    
    Dim oAddress As Object: Set oAddress = GetAddressForButton(oMailItem)
    If oAddress Is Nothing Then
        MsgBox "宛名が作成できません"
        Exit Sub
    End If
    
    Call MenuForm.AddButton(CStr(苗字_さん), MakeName(oAddress, 苗字_さん))
    Call MenuForm.AddButton(CStr(苗字_様), MakeName(oAddress, 苗字_様))
    Call MenuForm.AddButton(CStr(氏名_様), MakeName(oAddress, 氏名_様))
    Call MenuForm.AddButton(CStr(勤務先_氏名_様), MakeName(oAddress, 勤務先_氏名_様))
    Call MenuForm.AddButton(CStr(部署_役職_苗字_殿), MakeName(oAddress, 部署_役職_苗字_殿))
    
    Dim sButtonName As String: sButtonName = MenuForm.Display("宛名書きメニュー")
    If sButtonName = "" Then Exit Sub
    
    Dim nNameFormat As NameFormat: nNameFormat = CInt(sButtonName)
    
    Call WriteNamesAtTopMail(oMailItem, nNameFormat)
End Sub

クイックアクセスツールバーのコマンド（Project1.WriteNameMenu）ボタンから呼び出される関数です。処理の概要は次の通りです。

・作成中のメールからメニューボタン用のアドレス情報を取得します。
・そのアドレス情報を利用してメニューを作成します。
・メニューを表示して押されたボタン名を取得します。
・ボタン名で指定されるフォーマットの宛名をメール文頭に書き込みます。

モジュールのインポート

Outlookにそのままインポートできるモジュールファイルを以下に添付しますので、ダウンロードして次の操作でファイルインポートします。

パソコン上のダウンロードフォルダなどへダウンロードされた圧縮ファイルをエクスプローラーで展開します。この後の作業がしやすいように、圧縮ファイル内の４つのファイルをデスクトップなどへドラッグ＆ドロップでコピーします。

Outlookを起動してVBEを開き、展開した３つのモジュールを１つずつファイルインポートします。
手順は「VBA Outlook開発環境の整備」を参考にしてください。

３つのモジュールがインポートされました。

モジュールの圧縮ファイル添付

次に３つのモジュールファイルを圧縮したものを添付します。
ダウンロードしてインポートしてください。

クイックアクセスツールバーにコマンド追加

メッセージ編集ウィンドウを開いて、クイックアクセスツールバーにコマンド（Project1.WriteNameMenu）ボタンを追加します。ボタンアイコンはお好みで適当なものに変更してもよいでしょう。
手順は「VBA Outlook開発環境の整備」を参考にしてください。

プログラムの動作確認

それでは組み込んだプログラムの動作を確認します。
メッセージ編集ウィンドウで、宛先やCCに適当なアドレス情報を設定して、コマンド（Project1.WriteNameMenu）ボタンを押すと「宛名書きメニュー」ダイアログが表示されます。

「宛名書きメニュー」ダイアログで適当なボタンを押します。送信先に設定したアドレス情報から、選択したフォーマットで宛名が作成され、メール文頭に書き込まれれば動作は正常です。

メインモジュールの解説

ModuleWriteNameMenu.basモジュールのプログラムの主な内容を説明します。

NameFormatは宛名フォーマットのEnum列挙型変数です。ユニークな数値が割り付けられます。名前は宛名フォーマットを連想しやすいように日本語にしています。

Private Enum NameFormat
    苗字_さん
    苗字_様
    氏名_様
    勤務先_氏名_様
    部署_役職_苗字_殿
End Enum

WriteNameMenuは、宛名書きメニューのメイン関数でコマンドボタンから呼び出されます。メッセージ編集ウィンドウで作成中のメールのMailItemオブジェクトを取り出します

Public Sub WriteNameMenu()
    Dim oMailItem As MailItem: Set oMailItem = Application.ActiveInspector.CurrentItem

作成中のメールからメニューボタン用のアドレス情報を取得します。アドレス情報が取得できない場合は、有効なアドレス情報が無いため宛名が作成できません。メッセージを表示してプログラムを終了します。

    Dim oAddress As Object: Set oAddress = GetAddressForButton(oMailItem)
    If oAddress Is Nothing Then
        MsgBox "宛名が作成できません"
        Exit Sub
    End If

「宛名書きメニュー」を作成します。メニューフォームにボタンを追加していきます。第一引数はボタン名で、宛名フォーマットの番号を指定します。第２引数はボタン表示名で、先ほどのアドレス情報から宛名を作成して指定します。

    Call MenuForm.AddButton(CStr(苗字_さん), MakeName(oAddress, 苗字_さん))
    Call MenuForm.AddButton(CStr(苗字_様), MakeName(oAddress, 苗字_様))
    Call MenuForm.AddButton(CStr(氏名_様), MakeName(oAddress, 氏名_様))
    Call MenuForm.AddButton(CStr(勤務先_氏名_様), MakeName(oAddress, 勤務先_氏名_様))
    Call MenuForm.AddButton(CStr(部署_役職_苗字_殿), MakeName(oAddress, 部署_役職_苗字_殿))

「宛名書きメニュー」を表示して、押されたボタン名を戻り値として受け取ります。メニューの「X」が押されてキャンセルされた場合は、戻り値が空文字となるので、プログラムを終了します。

    Dim sButtonName As String: sButtonName = MenuForm.Display("宛名書きメニュー")
    If sButtonName = "" Then Exit Sub

ボタン名を、宛名フォーマットの番号数値に変換します。その宛名フォーマットを指定して宛名を作成してメール文頭に書き込みます。

    Dim nNameFormat As NameFormat: nNameFormat = CInt(sButtonName)
    
    Call WriteNamesAtTopMail(oMailItem, nNameFormat)

WriteNamesAtTopMailは、宛名をメール文頭に書き込む関数です。
Word の機能を呼び出して、選択範囲をメール文頭に移動します。

Private Sub WriteNamesAtTopMail(oMailItem As MailItem, nNameFormat As NameFormat)
    Const wdStory = 6   '文頭に移動
    Const wdMove = 0    '選択範囲解除して移動
    Dim oWord As Object: Set oWord = ActiveInspector.WordEditor.Application.Selection
    oWord.HomeKey Unit:=wdStory, Extend:=wdMove

複数の宛名を連結してメール文頭にWord機能で書き込みます。
「宛先」と「CC」で各々処理します。

    Dim sNames As String
    sNames = ConnectNames(oMailItem, olTo, nNameFormat)
    If sNames <> "" Then oWord.TypeText "宛先：" & sNames & vbNewLine
    
    sNames = ConnectNames(oMailItem, olCC, nNameFormat)
    If sNames <> "" Then oWord.TypeText "写し：" & sNames & vbNewLine

GetAddressForButtonはメニューボタン用のアドレス情報を取得する関数です。送信先に設定されたアドレス情報を１つずつ見ていき、アドレス情報を取り出せた時点で、そのアドレス情報を戻り値として関数を抜けます。

Private Function GetAddressForButton(oMailItem As MailItem) As Object
    Set GetAddressForButton = Nothing
    Dim oRecipient As Recipient
    For Each oRecipient In oMailItem.Recipients
        Set GetAddressForButton = GetAddress(oRecipient)
        If Not (GetAddressForButton Is Nothing) Then Exit Function
    Next oRecipient
End Function

ConnectNamesは、複数の宛名を連結する関数です。

nRecipientType引数は、olTo（宛先）やolCC（CC）を指定します。
nNameFormatは宛名フォーマット番号です。
DELIMITERは宛名を連結する際の区切り文字です。

Private Function ConnectNames(oMailItem As MailItem, nRecipientType As Integer, nNameFormat As NameFormat) As String
    Const DELIMITER = "、"
    
    ConnectNames = ""
    Dim oRecipient As Recipient
    For Each oRecipient In oMailItem.Recipients
        If oRecipient.Type = nRecipientType Then
            Dim oAddress As Object: Set oAddress = GetAddress(oRecipient)
            If Not (oAddress Is Nothing) Then
                If ConnectNames <> "" Then ConnectNames = ConnectNames & DELIMITER
                ConnectNames = ConnectNames & MakeName(oAddress, nNameFormat)
            End If
        End If
    Next oRecipient
End Function

GetAddressは、受信先oRecipientからアドレス情報を取得します。
まずは、Exchangeのグローバルアドレス一覧へ取りにいき、もしそこになければ、連絡帳へ取りにいきます。

Private Function GetAddress(oRecipient As Recipient) As Object
    Set GetAddress = Nothing
    On Error Resume Next
    
    Set GetAddress = oRecipient.AddressEntry.GetExchangeUser()
    If Not (GetAddress Is Nothing) Then Exit Function
    
    Set GetAddress = oRecipient.AddressEntry.GetContact()
    If Not (GetAddress Is Nothing) Then Exit Function
End Function

MakeNameは、アドレス情報から指定の宛名フォーマットで宛名を作成する関数です。Select Caseで、宛名フォーマットごとの処理へ分岐して、宛名を作成して戻り値として返します。
アドレス情報の主なプロパティは次の通りです。
LastName：姓
FirstName：名
CompanyName：勤務先（会社名）
Department：部署名
JobTitle：役職名

Private Function MakeName(oAddress As Object, nNameFormat As NameFormat) As String
    MakeName = ""
    If oAddress Is Nothing Then Exit Function
    Select Case nNameFormat
        Case 苗字_さん
            MakeName = _
                oAddress.LastName & "さん"
            
        Case 苗字_様
            MakeName = _
                oAddress.LastName & " 様"
            
        Case 氏名_様
            MakeName = _
                oAddress.LastName & oAddress.FirstName & " 様"
            
        Case 勤務先_氏名_様
            MakeName = _
                AddSpace(oAddress.CompanyName) & _
                oAddress.LastName & oAddress.FirstName & " 様"
            
        Case 部署_役職_苗字_殿
            MakeName = _
                AddSpace(oAddress.Department) & _
                AddSpace(oAddress.JobTitle) & _
                oAddress.LastName & " 殿"
    End Select
End Function

sItemが空文字でなければ、末尾に半角スペースを追加します。例えば、勤務先と氏名の間にスペースを含める時などに使用します。

Private Function AddSpace(sItem As String) As String
    If sItem <> "" Then AddSpace = sItem & " "
End Function

メニューのユーザーフォーム

MARGINはメニューのボタン周りのマージンで、５ポイントとします。
sPushedButtonNameは、押されたボタン名を格納する変数です。
nButtonMaxWidthは、ボタンの最大横幅を記憶する変数です。
oButtonCollectionは、ユーザーフォームに追加したボタンオブジェクトを保持しておくための変数です。

Private Const MARGIN As Single = 5

Private sPushedButtonName As String
Private nButtonMaxWidth As Single
Private oButtonCollection As Collection

UserForm_Initializeは、ユーザーフォームの初期化時に実行されます。

Private Sub UserForm_Initialize()
    sPushedButtonName = ""
    nButtonMaxWidth = 0
    Set oButtonCollection = New Collection
End Sub

AddButtonは、ユーザーフォームMenuFormにコマンドボタンを追加する処理です。sNameはボタン名、sCaptionはボタン表示名を指定します。

Public Sub AddButton(sName As String, sCaption As String)
    Dim oButton As MSForms.CommandButton
    Set oButton = MenuForm.Controls.Add("Forms.CommandButton.1", CStr(sName))

ボタンのサイズを自動調整として、ボタン表示名を設定すると、ボタン幅が自動調整されます。MARGINも加味してボタンの左上位置を指定して配置します。また、ボタンの最大横幅を記憶します。

    With oButton
        .AutoSize = True
        .Caption = CStr(sCaption)
        .Top = MARGIN + (.Height + MARGIN) * oButtonCollection.Count
        .Left = MARGIN
        
        If nButtonMaxWidth < .Width Then nButtonMaxWidth = .Width
    End With

メニューボタンクラスのインスタンスを生成してボタンオブジェクトを設定し、保持変数に追加します。

    Dim oMenuButton As New ClassMenuButton
    oMenuButton.SetButton oButton
    
    oButtonCollection.Add oMenuButton

押されたボタン名をモジュール変数sPushedButtonNameに登録します。

Public Sub SetPushedButtonName(sButtonName As String)
    sPushedButtonName = sButtonName
End Sub

メニューを表示して、押されたボタン名を返します。
sFormTitleは、ユーザーフォームのタイトル名として設定します。
全てのボタンの横幅を最大横幅のものに合わせます。また、全てのボタンを配置した時のトータル高さを求め、ユーザーフォームのサイズを調整して表示します。

Public Function Display(sFormTitle As String) As String
    Dim nTotalHeight As Single: nTotalHeight = MARGIN
    Dim oControl As Object
    For Each oControl In MenuForm.Controls
        oControl.Width = nButtonMaxWidth
        nTotalHeight = nTotalHeight + (oControl.Height + MARGIN)
    Next oControl
    
    With MenuForm
        .Caption = sFormTitle
        .Width = (.Width - .InsideWidth) + nButtonMaxWidth + MARGIN * 2
        .Height = (.Height - .InsideHeight) + nTotalHeight
        
        .Show vbModal
    End With
    
    Display = sPushedButtonName
    
    Unload MenuForm
End Function

メニューボタンのクラスモジュール

WithEvents定義で、Button_Clickイベントを受け取れるようにします。

Private WithEvents Button As MSForms.CommandButton

Public Sub SetButton(oButton As MSForms.CommandButton)
    Set Button = oButton
End Sub

Button_Clickイベント処理は、ボタンクリックで呼び出され、押されたボタン名を受け渡して、メニューを非表示とします。

Private Sub Button_Click()
    MenuForm.SetPushedButtonName Button.Name
    MenuForm.Hide
End Sub

さいごに

これで、Outlookメール宛名書きメニュー化のツールは完成です。
最後までお読みいただきありがとうございました。
お気づきの点などありましたらコメント頂けますと幸いです。

記事を気に入って頂き、お役に立てたら嬉しいです。