はじめに

同じ内容のメールを、異なる宛先へ、メール本文の送信先の会社名・担当者名を変更しながら、1件ずつ、送信したい。
これを手作業でやると、間違いも発生しやすく、何より面倒だ。
そのため、エクセルを使って、宛先、本文を差し込んだメールを作成する方法を模索した。

作成までの経緯

前提として、動作環境は以下の通りである。
・Windows11
・使用しているメーラーはWebメールの「Outlook on the web」
・ブラウザは「Microsoft Edge」

当初、mailtoを使った方法を考えた。

しかし、文字数制限があるため、長い本文が入りきらず、諦めた。
　

次に、以下URLを参考にディープリンクを使った方法を試した。

だが、CC、BCCに対応できない、こちらも、文字数が一定以上になるとエラーになるなど、問題があった。

　
特に、悩んだのが、本文の長さによる文字数制限エラーだ。
どうしても本文を短くできず、最終的に、本文を差し込むのは諦めた。

結局、mailtoリンクを使って、宛先、件名、CC、BCCのみを差し込んだメールを作成し、メール本文は、クリップボードに本文を送るまでは自動化し、作成したメール画面で本文を貼り付ける作業だけ、手作業とする運用にした。
完全自動化ではないが、ほとんど自動化できたので、許容範囲としたい。

事前設定

mailtoリンクで、Outlook on the webをMicrosoft Edgeで開くには、事前設定が必要になる。

事前設定手順

１. 既定のアプリのMAILTOを設定する

　①Windowsの設定画面から、「アプリ」⇒「既定のアプリ」の画面を開く

【Windows設定の既定のアプリ選択画面】

　②検索欄に「mailto」と入力、MAILTOの既定を「Microsoft Edge」に変更する。
　
【既定のアプリ MAILTO設定画面】

２. ブラウザのプロトコルハンドラー設定

　① Microsoft Edgeの設定画面から、「Cookieとサイトのアクセス許可」⇒「プロトコルハンドラー」を開く

【Microsoft Edge 設定画面プロトコルハンドラー選択画面】

　②「サイトがプロトコルの既定のハンドラーとなることを求めることを許可する」をオンにする

【プロトコルハンドラー許可設定画面】

　
　③ Outlook on the webを開き、アドレスバーのひし形が重なったマークを押す

　
　④ 「メールリンクを開くことをoutolook.office.comに許可しますか？」を許可する

参考URL：

Google Chromeでメールのリンクを開くようにするには？ | Indeed (インディード)

作成したマクロの概要

エクセルに以下のような表を作成し、宛先のメールアドレスのリンクをクリックして、メールを作成する仕様とした。

操作手順

メールリンク作成ボタンを押し、あらかじめ宛先欄に空のハイパーリンクを設定しておく
宛先欄のリンクをクリックすると、FollowHyperlinkイベントが発生し、以下の処理を行う
① 宛先情報の会社名・担当者を文頭に追加した本文データをクリップボードへ送る
② 送信情報を基にmailtoリンクを作成する
③ 作成したmailtoリンクをクリックする動作を起こして、メールを作成する
④ 作成したmailtoリンクを空のハイパーリンクに戻す
作成されたメールにクリップボードへ送った本文を手動で貼り付ける

上記を踏まえ、2つのプロシージャをシートモジュール（メール作成シート）に作成した。

シートモジュール（メール作成シート）
①「CreateBlankLink」プロシージャ：
　宛先欄に空のハイパーリンクを設定する
②「Worksheet_FollowHyperlink」イベントプロシージャ：
　本文データをクリップボードに送り、mailtoリンクを作成して、メールを作成する

　
mailtoリンクの作成について、当初、リンク作成ボタンを押して、宛先欄に直接、mailtoリンクを作成する仕様としていた。
しかし、リストのデータを変更した場合、再度、リンク作成ボタンを押して、リンクを作成し直さなければ、変更したデータが反映されない。
そのため、リンク作成ボタンを押し忘れて、変更が反映されていないということが、度々あった。

ワークシートのHYPERLINK関数であれば、すぐに変更が反映されると思ったが、HYPERLINK関数のハイパーリンクをクリックしても、FollowHyperlinkイベントが発生せず、FollowHyperlinkイベントが発生しないと、クリップボードへ本文を送る処理が実行できないため、断念した。

試行錯誤した結果、宛先欄にmailtoリンクを作成しておくのではなく、とりあえず空のリンクを宛先欄に作成しておき、FollowHyperlinkイベントプロシージャ内で、現在のリストのデータを基にmailtoリンクを作成し、リンクをクリックする動作を起こして、メールを作成する仕様とした。

補足：

作成に当たって、本文のデータをクリップボードへ送る際、DataObjectを使ったクリップボード操作では、エラーが生じるという問題が発生した。
そのため、以下URLを参考に、DataObjectを使わず、TextBoxを経由して文字列をコピーする方法とした。

完成したマクロ

シートモジュール（メールシート）に作成

シートモジュール（メールシート）

Public Sub CreateBlankLink()
Dim i As Long
Dim myHyperlink  As Hyperlink  
    i = 4
    Do            
        Cells(i, "E").Hyperlinks.Delete
        Cells(i, "E").Borders.LineStyle = xlContinuous
        Set myHyperlink = ActiveSheet.Hyperlinks.Add(Anchor:=Cells(i, "E"), Address:="", ScreenTip:="メールアドレスをクリック")
        i = i + 1
    Loop Until Cells(i, "E").Value = ""
End Sub


Private Sub Worksheet_FollowHyperlink(ByVal Target As Hyperlink)
Dim Title As String
Dim Body As String
Dim myHyperlink  As Hyperlink
Dim TargetRow As Long 

    TargetRow = ActiveCell.Row
    
    '件名に改行がある場合は削除し、全角の空白を半角の空白にした後、半角の空白を「%20」にエンコード
    '半角の「&」があるとうまく作動しないため、全角の「＆」に置き換え
    Title = Replace(Replace(Replace(WorksheetFunction.Clean(Cells(TargetRow, "D").Value), "　", " "), " ", "%20"), "&", "＆")
    Body = Cells(TargetRow, "H").Value & vbCrLf & Replace(Cells(TargetRow, "I"), Chr(10), " 様" & Chr(10)) & " 様" & vbCrLf & vbCrLf & Range("B4") & vbCrLf
 
     With CreateObject("Forms.TextBox.1")
       .MultiLine = True
       .Text = Body
       .SelStart = 0
       .SelLength = .TextLength
       .Copy
     End With
    
      Set myHyperlink = Hyperlinks.Add(Anchor:=Cells(TargetRow, "E"), _
                        Address:="mailto:" & Cells(TargetRow, "E") & _
                        "?cc=" & Cells(TargetRow, "F") & _
                        "&bcc=" & Cells(TargetRow, "G") & _
                        "&subject=" & Title, _
                        TextToDisplay:=Cells(TargetRow, "E").Value, ScreenTip:="メールアドレスをクリック")
    
      Application.EnableEvents = False       
      Selection.Hyperlinks(1).Follow
      Application.EnableEvents = True
      
      Set myHyperlink = ActiveSheet.Hyperlinks.Add(Anchor:=Cells(TargetRow, "E"), Address:="", ScreenTip:="メールアドレスをクリック")
      
End Sub

サンプルファイル保存先：