この記事の要約
- 課題・悩み「メールで会社名な名前を入力するのが面倒」
- 解決策「Outlookのメールのアドレスから本文に宛先を自動入力するVBAマクロ」を解説
メールを作成する際に、いちいち宛先を入力するのは面倒。
「前株？あと株？」「どのサイトウさんだっけ？」
そこで、メールのTOに入力されたアドレスから自動で宛先を入力するVBAマクロを作成しました。
コピペで使えます。
【Outlookのメールのアドレスから本文に宛先を自動入力するVBAマクロのコード】を解説しています。
Toに入力されているメールアドレスから会社名と名前を自動で本文に挿入するVBAマクロ
メールアドレスを作成する際に会社名や名前といった宛先を入力するのが面倒。
会社名の（株）は前株？後株？
サイトウさんの漢字どれだっけ？
そこで【Toに入力しているメールアドレスから自動で会社名と名前を本文に入力するVBAマクロ】を作成しました。
設定したマクロをワンクリックするだけで自動で本文に宛先が入力されます。
自動宛先入力マクロを使用するために必要な設定
自動宛先入力マクロを実施するために必要な設定は以下の通りです。
連絡先の登録
自動入力される情報は、Outlook の連絡先の【勤務先】と【姓】に設定しています。
そのため、事前に連絡先に相手の勤務先と名字を登録して置く必要があります。
マクロの登録
下記のVBAマクロのコードをコピーして、自分のパソコンのOutlookのVisual Basic Editorに入力します。
Sub 宛先の自動挿入()
Dim objReItem As Outlook.MailItem
Dim recipient As Outlook.recipient
Dim strAddBody As String
Dim recipientAddress As String
Dim domainToCheck As String
Dim myContactItem As Outlook.ContactItem
Dim japaneseLastName As String
Dim exUser As Outlook.ExchangeUser
Dim objDOC As Object
Dim rng As Object
Dim docEnd As Long
' 特定のドメインを設定
domainToCheck = "@example.com" ' ここを一般的なドメインに置き換えます。
' 現在表示中のメールアイテムを取得
Set objReItem = ActiveInspector.CurrentItem
Set recipient = objReItem.Recipients.Item(1)
' ExchangeUserオブジェクトを取得
On Error Resume Next
Set exUser = recipient.AddressEntry.GetExchangeUser
On Error GoTo 0
' Eメールアドレスを取得
If Not exUser Is Nothing Then
recipientAddress = exUser.PrimarySmtpAddress
Else
recipientAddress = recipient.Address
End If
' ドメインに基づいて処理を分岐
If InStr(recipientAddress, domainToCheck) > 0 Then
' recipient.Nameから名字を取得（" 名前" の部分を削除）
japaneseLastName = Split(recipient.Name, " ")(0)
strAddBody = japaneseLastName & "さん" & vbCrLf & vbCrLf & "お世話になっております。" & vbCrLf
Else
On Error Resume Next
Set myContactItem = recipient.AddressEntry.GetContact
On Error GoTo 0
If Not myContactItem Is Nothing Then
With myContactItem
strAddBody = .CompanyName & vbCrLf & .Department & " " & .LastName & " 様" & vbCrLf & vbCrLf & "いつもお世話になっております。" & vbCrLf
End With
Else
MsgBox "宛先の連絡先を取得できませんでした。", vbExclamation
Exit Sub
End If
End If
' WordEditorオブジェクトを取得
Set objDOC = objReItem.GetInspector.WordEditor
' 挨拶文を本文の先頭に追加
Set rng = objDOC.Range(0, 0)
rng.InsertBefore strAddBody
' ドキュメントの末尾の位置を取得
docEnd = objDOC.Content.End
' 挿入した挨拶文の範囲にフォントを設定
Set rng = objDOC.Range(0, docEnd)
rng.Font.Name = "Yu Gothic"
rng.Font.Size = 11
' メールを表示
objReItem.Display
' 使用したオブジェクトの解放
Set myContactItem = Nothing
Set recipient = Nothing
Set objReItem = Nothing
Set exUser = Nothing
Set objDOC = Nothing
Set rng = Nothing
End Sub
クイックアクセスツールバーまたはリボンへのマクロの登録
登録したマクロを素早く実行するには、クイックアクセスツールバーまたはリボンへ登録するのがおすすめです。
メールのアドレスから宛先を本文に自動入力するVBAマクロを使うための準備
【メールのアドレスから宛先を本文に自動入力するVBAマクロ】を使うためには、アドレスを連絡先に登録する必要があります。
自動入力したいアドレスを連絡先に登録する
アドレスを連絡先に保存する方法は以下の通りです。
受信トレイで、連絡先に登録したいメールを開きます。
メールの上部にある送信者の名前をクリックします。
【…】をクリックします。
【連絡先フォルダに追加】をクリックします。
【勤務先】に会社名を【姓】に名字を入力します。
連絡先の【勤務地】と【姓】に入力した情報が自動宛先として、メール本文に挿入されます。
【保存して閉じる】をクリックします。
メールのアドレスから宛先を本文に自動入力するVBAマクロのコード_社内社外で条件分岐
私の会社では、OutlookがExchangeで管理されているため、【勤務先】と【姓】を連絡先に登録してもメールの宛先として取得することができませんでした。
そのため、社内のアドレスの宛先はExchangeで管理されている【表示名】から取得し、社外のアドレスの宛先は連絡先に自分で登録した【勤務先】と【姓】から取得するようにしました。
メールのアドレスから宛先を本文に自動入力するVBAマクロのコード_社内社外で条件分岐
- 社内のアドレス…【@社内のアドレス】
- 社外のアドレス…【@社内のアドレス】以外
このVBAマクロは、Microsoft Outlookで選択されたメールアイテムに対して特定の条件に基づき宛名を挿入する自動化スクリプトです。
Sub 指定宛先に挨拶文を挿入するALL()
Dim objReItem As Outlook.MailItem
Dim recipient As Outlook.recipient
Dim strAddBody As String
Dim recipientAddress As String
Dim domainToCheck As String
Dim myContactItem As Outlook.contactItem
Dim japaneseLastName As String
Dim exUser As Outlook.exchangeUser
Dim objDOC As Object
Dim objWord As Word.Application
Dim objSel As Word.Selection
' 特定のドメインを設定
domainToCheck = "@example.com" ' ここを一般的なドメインに置き換えます。
' 現在表示中のメールアイテムを取得
Set objReItem = ActiveInspector.CurrentItem
Set recipient = objReItem.Recipients.Item(1)
' ExchangeUserオブジェクトを取得
On Error Resume Next
Set exUser = recipient.AddressEntry.GetExchangeUser
On Error GoTo 0
' Eメールアドレスを取得
If Not exUser Is Nothing Then
recipientAddress = exUser.PrimarySmtpAddress
Else
recipientAddress = recipient.Address
End If
' ドメインに基づいて処理を分岐
If InStr(recipientAddress, domainToCheck) > 0 Then
' recipient.Nameから名字を取得（" 名前" の部分を削除）
japaneseLastName = Split(recipient.Name, " ")(0)
strAddBody = japaneseLastName & "さん" & vbCrLf & vbCrLf & "お世話になっております。" & vbCrLf
Else
On Error Resume Next
Set myContactItem = recipient.AddressEntry.GetContact
On Error GoTo 0
If Not myContactItem Is Nothing Then
With myContactItem
strAddBody = .CompanyName & vbCrLf & .Department & " " & .lastName & " 様" & vbCrLf & vbCrLf & "いつもお世話になっております。" & vbCrLf
End With
Else
MsgBox "宛先の連絡先を取得できませんでした。", vbExclamation
Exit Sub
End If
End If
' WordEditorオブジェクトを取得
Set objDOC = objReItem.GetInspector.WordEditor
Set objWord = objDOC.Application
' 挨拶文を本文の先頭に追加し、フォントを游ゴシックに設定
objDOC.Range(0, 0).InsertBefore strAddBody
objDOC.Range(0, Len(strAddBody)).Font.Name = "Yu Gothic"
objDOC.Range(0, Len(strAddBody)).Font.Size = 11
' メールを表示
objReItem.Display
' 使用したオブジェクトの解放
Set myContactItem = Nothing
Set recipient = Nothing
Set objReItem = Nothing
Set exUser = Nothing
Set objDOC = Nothing
Set objWord = Nothing
Set objSel = Nothing
End Subドメインにより入力を分岐させているのは、社内のアドレスがExchange環境で管理されており、自分で登録した連絡先を参照できないようになっていたからです。
そこで、社外は登録した【連絡先】の【勤務先】と【姓】のデータを、社内は【表示名】のデータを参照するようにコードを作成しています。
処理の概要
特定のドメイン設定
メールの受信者が特定のドメインに属しているかを判断する基準を設定します。
domainToCheck = "@example.com"メールアイテムの取得
現在Outlookで開いているメールアイテムとその受信者情報を取得します。
Set objReItem = ActiveInspector.CurrentItem
Set recipient = objReItem.Recipients.Item(1)受信者のメールアドレス取得
受信者のExchangeUserオブジェクトを取得し、そこからメールアドレスを抽出します。
Set exUser = recipient.AddressEntry.GetExchangeUser
recipientAddress = exUser.PrimarySmtpAddress挨拶文のカスタマイズ
受信者の情報に基づいて適切な挨拶文を作成します。
特定のドメインに属する日本の受信者には名字を用い、それ以外の場合は連絡先情報を使用します。
If InStr(recipientAddress, domainToCheck) > 0 Then挨拶文の挿入
Wordエディタを通じてメール本文の最初に挨拶文を挿入し、フォントを設定します。
objDOC.Range(0, 0).InsertBefore strAddBodyリソースの解放
使用したオブジェクトへの参照をクリアして、リソースを解放します。
Set myContactItem = Nothing注意点
データ量
このマクロは、一度に1つのメールアイテムにのみ作用します。
複数のメールに対して同じ操作を行う場合は、メールごとに実行する必要があります。
データ量が多くないため、処理にかかる時間は通常は問題になりません。
実行の取り消し
VBAで実行した操作は、一般的に元に戻せません。
メールに挨拶文を挿入した後、それを取り消したい場合は手動で行う必要があります。
セキュリティ
マクロを実行するには、OutlookおよびWordのセキュリティ設定でマクロを許可する必要があります。
マクロの実行はセキュリティリスクを伴う場合があるため、信頼できるマクロのみを使用してください。
必要な環境設定
参照設定
このマクロを実行するには、VBAエディタ内で「Microsoft Outlook 16.0 Object Library」および「Microsoft Word 16.0 Object Library」への参照設定が必要です。
これらの設定は、VBAエディタのツールメニュー内の「参照設定…」から追加できます。
セキュリティ設定
OutlookおよびWordでマクロを許可する設定を確認し、必要に応じて調整してください。
セキュリティの警告が表示された場合は、マクロのソースが信頼できるものであることを確認してから実行してください。
参照設定
このマクロを実行するには、Outlookがインストールされていること、および “Microsoft Outlook 16.0 Object Library”（または使用しているOutlookのバージョンに応じたもの）への参照設定が追加されていることが必要です。
これはVBAエディタの「ツール」メニューの「参照設定」から行えます。
メールの編集には “Microsoft Word 16.0 Object Library” の参照設定も必要になることがあります。
これは、メール本文の編集にWordの機能を利用するためです。
カスタマイズ箇所
このコードをご自身の環境で使用するために変更が必要な部分について、以下にまとめました。
変更が必要な箇所は主に、特定のドメイン名、挨拶文の内容、およびフォントの設定です。
これらの変更を行うことで、コードを自分の環境や好みに合わせてカスタマイズすることができます。
ドメインの設定
メールの受信者が特定のドメインに属しているか判断するためのドメイン名。
自分の環境や目的に応じてこの値を適切なドメインに変更します。
domainToCheck = "@example.com"ドメインの設定の注意点
自分が対応したい特定のドメインを正確に指定してください。
間違ったドメインを設定すると、意図した受信者に対して挨拶文が挿入されない可能性があります。
挨拶文のカスタマイズ
受信者に応じた挨拶文。
受信者の名前や所属に応じて挨拶文を変更したい場合、この部分を編集します。
特に、文化的な背景やビジネスシーンに合わせて挨拶文を調整することができます。
特定のドメインに属する受信者用：
strAddBody = japaneseLastName & "さん" & vbCrLf & vbCrLf & "お世話になっております。" & vbCrLf
その他の受信者用：
strAddBody = .CompanyName & vbCrLf & .Department & " " & .lastName & " 様" & vbCrLf & vbCrLf & "いつもお世話になっております。" & vbCrLf挨拶文のカスタマイズの注意点
挨拶文は、受信者の文化やビジネス環境に適している必要があります。
不適切な挨拶文を使用すると、受信者に対して失礼にあたる場合があります。
フォント設定
メールの挨拶文に使用するフォントの種類とサイズ。
文書のフォーマットに合わせて、または個人の好みに応じてフォント名やサイズを変更します。
objDOC.Range(0, Len(strAddBody)).Font.Name = "Yu Gothic"
objDOC.Range(0, Len(strAddBody)).Font.Size = 11フォント設定の注意点
選択するフォントは、メールを読む受信者のコンピューターにインストールされている必要があります。
一般的に使用されているフォントを選ぶか、あるいはメールの受信者が使用している環境を考慮してください。
メールのアドレスから宛先を本文に自動入力するVBAマクロのコード_連絡先から情報を取得
このVBAでは、受信者の連絡先情報から企業名と部署を用いて挨拶文を生成します。
Sub 挨拶文を挿入_連絡先基準()
Dim objReItem As Outlook.MailItem
Dim recipient As Outlook.Recipient
Dim strAddBody As String
Dim myContactItem As Outlook.ContactItem
Dim objDOC As Object
' 現在表示中のメールアイテムを取得
Set objReItem = ActiveInspector.CurrentItem
Set recipient = objReItem.Recipients.Item(1)
' 連絡先情報を取得し、挨拶文を生成
On Error Resume Next
Set myContactItem = recipient.AddressEntry.GetContact
If Not myContactItem Is Nothing Then
With myContactItem
strAddBody = .CompanyName & vbCrLf & .Department & " " & .LastName & " 様" & vbCrLf & vbCrLf & "いつもお世話になっております。" & vbCrLf
End With
' WordEditorオブジェクトを取得し、挨拶文を本文の先頭に追加し、フォントを設定
Set objDOC = objReItem.GetInspector.WordEditor
objDOC.Range(0, 0).InsertBefore strAddBody
objDOC.Range(0, Len(strAddBody)).Font.Name = "Yu Gothic"
objDOC.Range(0, Len(strAddBody)).Font.Size = 11
' メールを表示
objReItem.Display
Else
MsgBox "宛先の連絡先を取得できませんでした。", vbExclamation
End If
On Error GoTo 0
' 使用したオブジェクトの解放
Set objReItem = Nothing
Set recipient = Nothing
Set myContactItem = Nothing
Set objDOC = Nothing
End SubこのVBAマクロは、Outlookで現在表示中のメールに対して、その宛先（受信者）の連絡先情報に基づいた挨拶文を自動で挿入する処理を行います。
そのため、事前に自動入力したい宛先を連絡先に登録して、会社名と名字を入力しておく必要があります。
処理ごとの解説
現在表示中のメールアイテムの取得
メールを作成または読んでいる際に開いているウィンドウ（インスペクター）から、現在操作しているメールアイテムを取得します。
Set objReItem = ActiveInspector.CurrentItem宛先の取得
メールの宛先（受信者）のリストから最初の宛先を取得します。
Set recipient = objReItem.Recipients.Item(1)連絡先情報の取得と挨拶文の生成
宛先の連絡先情報を取得し、その情報から挨拶文を組み立てます。
連絡先情報が取得できない場合は、エラーメッセージを表示します。
Set myContactItem = recipient.AddressEntry.GetContact とその後の If Not myContactItem Is Nothing Then ブロック挨拶文の挿入とフォントの設定
取得したWordEditorオブジェクトを使用して、メール本文の先頭に挨拶文を挿入し、フォントの種類とサイズを設定します。
Set objDOC = objReItem.GetInspector.WordEditor とその後の処理オブジェクトの解放
使用したオブジェクトをメモリから解放し、リソースをクリーンアップします。
最後の4行注意点
処理時間
データが大量にある場合（例えば、受信者リストが非常に大きい場合）、処理に時間がかかることがあります。
これは、各受信者の連絡先情報を取得する際に、外部の連絡先データベースやアドレス帳にアクセスする必要があるためです。
バックアップしてから実行
VBAマクロで実行した操作は基本的に元に戻せません。
特にメールに対する変更は注意が必要です。
変更を加える前に、必要であればメールの内容をバックアップするなどの対策をとるとよいでしょう。
必要な環境設定
参照設定
このマクロを実行するには、Outlookがインストールされていること、および “Microsoft Outlook 16.0 Object Library”（または使用しているOutlookのバージョンに応じたもの）への参照設定が追加されていることが必要です。
これはVBAエディタの「ツール」メニューの「参照設定」から行えます。
メールの編集には “Microsoft Word 16.0 Object Library” の参照設定も必要になることがあります。
これは、メール本文の編集にWordの機能を利用するためです。
カスタマイズ箇所
このVBAマクロをご自身の環境で利用する際に変更する可能性がある箇所は主に挨拶文の内容やフォントの種類、サイズです。
これらは個人の好みや使用環境に合わせて調整することが推奨されます。
以下に、変更する可能性のある箇所とその解説をまとめた表を示します。
挨拶文の内容
挨拶文は受信者の連絡先情報に基づいて自動生成されますが、このメッセージは状況や好みに応じて変更可能です。
例えば、よりカジュアルな挨拶や、異なる言語での挨拶に変更したい場合などが考えられます。
strAddBody = .CompanyName & vbCrLf & .Department & " " & .LastName & " 様" & vbCrLf & vbCrLf & "いつもお世話になっております。" & vbCrLfフォントの種類
挨拶文のフォントの種類は、「Yu Gothic」に設定されていますが、この設定はご自身が使用しているメールの標準フォントや好みのフォントに合わせて変更することができます。
objDOC.Range(0, Len(strAddBody)).Font.Name = "Yu Gothic"フォントのサイズ
挨拶文のフォントサイズは11に設定されていますが、これも読みやすさや好みに応じて調整することが可能です。
objDOC.Range(0, Len(strAddBody)).Font.Size = 11メールのアドレスから宛先を本文に自動入力するVBAマクロのコード_受信者の名字名から情報を取得
このVBAでは、受信者の名字に基づいて挨拶文を生成します。
Sub 挨拶文を挿入_名字基準()
Dim objReItem As Outlook.MailItem
Dim recipient As Outlook.Recipient
Dim strAddBody As String
Dim recipientAddress As String
Dim japaneseLastName As String
Dim exUser As Outlook.ExchangeUser
Dim objDOC As Object
' 現在表示中のメールアイテムを取得
Set objReItem = ActiveInspector.CurrentItem
Set recipient = objReItem.Recipients.Item(1)
' ExchangeUserオブジェクトを取得し、Eメールアドレスを取得
On Error Resume Next
Set exUser = recipient.AddressEntry.GetExchangeUser
If Not exUser Is Nothing Then
recipientAddress = exUser.PrimarySmtpAddress
Else
recipientAddress = recipient.Address
End If
On Error GoTo 0
' 宛先の名前から日本語の挨拶文を生成
japaneseLastName = Split(recipient.Name, " ")(0)
strAddBody = japaneseLastName & "さん" & vbCrLf & vbCrLf & "お世話になっております。" & vbCrLf
' WordEditorオブジェクトを取得し、挨拶文を本文の先頭に追加し、フォントを設定
Set objDOC = objReItem.GetInspector.WordEditor
objDOC.Range(0, 0).In
コメント