Excelマクロ｜Web版Outlookメール作成ツール

実現したいこと

前提

Excelマクロを使って、Web版Outlookでメールを作成したいです。

発生している問題・エラーメッセージ

CCとBCCのみ、値が入りません。 修正箇所があれば、教えていただきたいです。

該当のソースコード

下記コードでccとbccのみ反映されません。原因はなんでしょうか？ Sub CreateEmailInOutlookWeb() Dim recipient As String Dim cc As String Dim bcc As String Dim subject As String Dim body As String Dim mailtoUrl As String ' Excelシートのセルから値を取得 recipient = URLEncode(Range("C2").Value) cc = URLEncode(Range("C3").Value) bcc = URLEncode(Range("C4").Value) subject = URLEncode(Range("C5").Value) body = URLEncode(Range("C6").Value) ' メール作成のURLを生成 mailtoUrl = "https://outlook.office.com/mail/deeplink/compose?to=" & recipient ' CCが設定されている場合、URLに追加 If cc <> "" Then mailtoUrl = mailtoUrl & "&cc=" & cc End If ' BCCが設定されている場合、URLに追加 If bcc <> "" Then mailtoUrl = mailtoUrl & "&bcc=" & bcc End If ' 件名と本文を追加 mailtoUrl = mailtoUrl & "&subject=" & subject & "&body=" & body ' URLを既定のブラウザで開く ThisWorkbook.FollowHyperlink Address:=mailtoUrl End Sub Function URLEncode(ByVal Text As String) As String Dim i As Integer Dim Char As String Dim Result As String Result = "" For i = 1 To Len(Text) Char = Mid(Text, i, 1) Select Case Asc(Char) Case 48 To 57, 65 To 90, 97 To 122 ' 0-9, A-Z, a-z Result = Result & Char Case 32 Result = Result & "%20" Case 33 To 47, 58 To 64, 91 To 96, 123 To 126 Result = Result & "%" & Right("0" & Hex(Asc(Char)), 2) Case Else Result = Result & "%" & Right("0" & Hex(Asc(Char)), 2) End Select Next i URLEncode = Result End Function