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 EnumWriteNameMenuは、宛名書きメニューのメイン関数でコマンドボタンから呼び出されます。メッセージ編集ウィンドウで作成中のメールの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 & vbNewLineGetAddressForButtonはメニューボタン用のアドレス情報を取得する関数です。送信先に設定されたアドレス情報を１つずつ見ていき、アドレス情報を取り出せた時点で、そのアドレス情報を戻り値として関数を抜けます。
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 FunctionConnectNamesは、複数の宛名を連結する関数です。
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 FunctionGetAddressは、受信先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 FunctionMakeNameは、アドレス情報から指定の宛名フォーマットで宛名を作成する関数です。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 FunctionsItemが空文字でなければ、末尾に半角スペースを追加します。例えば、勤務先と氏名の間にスペースを含める時などに使用します。
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 CollectionUserForm_Initializeは、ユーザーフォームの初期化時に実行されます。
Private Sub UserForm_Initialize()
sPushedButtonName = ""
nButtonMaxWidth = 0
Set oButtonCollection = New Collection
End SubAddButtonは、ユーザーフォーム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 SubButton_Clickイベント処理は、ボタンクリックで呼び出され、押されたボタン名を受け渡して、メニューを非表示とします。
Private Sub Button_Click()
MenuForm.SetPushedButtonName Button.Name
MenuForm.Hide
End Subさいごに
これで、Outlookメール宛名書きメニュー化のツールは完成です。
最後までお読みいただきありがとうございました。
お気づきの点などありましたらコメント頂けますと幸いです。
いいなと思ったら応援しよう！
