VBA ExcelでOutlookのメール作成画面を表示する

Question

いつもお世話になっております。
下記の【やりたいこと】を作成したいのですが難航しており力添え頂きたいです。
以下に詳細を記載しています。

【シート内容】
Sheet1の内容
ActiveXのTextBox1,CommandButton1
C列に氏名、D列に第一メールアドレス、
E列に第二メールアドレスが存在する(約100件)
Sheet2の内容
B1にメールの件名、B2にメールの本文が記入されている

【やりたいこと】
・Sheet１のTextBox1に氏名を入力してCommandButton1をクリックしSheet1に記載されている氏名(C列)の中から同じ氏名をヒットさせる
・氏名がヒットしたらTOに第一メールアドレス(D列)、CCに第二メールアドレス(E列)、件名にSheet2の件名(B1)、本文にSheet2の本文(B2)が入力された状態でOutlookのメール作成画面が表示されるようにしたい。
・検索がヒットしなければ"存在しません"と表示する

下記の作成したコード①と②を合わせたコードを作成しようと思いましたが上手くいかなかったので一旦、別々のコードを作ってみました。
作成したコード①と②を合わせたいです。初心者なので間違っているコードがあると思いますがご教授お願い致します。

【作成した内容①TextBox1に入力した氏名と同じ氏名をSheet1のC列からヒットさせる】
Private Sub CommandButton1_Click()

Dim F As Variant

Set myRange = ActiveSheet.Range("C10:E100")
Set rngSearch = myRange.Find(What:=TextBox1.Value, LookAt:=xlPart)

If TextBox1 = "" Then
MsgBox "氏名を入力してください。"
Else
If Not rngSearch Is Nothing Then
rngSearch.select
Else
MsgBox "見つかりませんでした。"
End If
End If

End Sub

【作成した内容②メール作成】
Sub OUTLOOK()

Dim objOutlook As Outlook.Application
Dim objMail As Outlook.MailItem
Dim wsMail As Worksheet

Set objOutlook = New Outlook.Application
Set wsMail = ThisWorkbook.Sheets("送信内容")

Set objMail = objOutlook.CreateItem(olMailItem)

With wsMail

objMail.To = wsList.Cells(i, 4).Value
objMail.CC = wsList.Cells(i, 5).Value
objMail.Subject = .Range("B1").Value
objMail.BodyFormat = olFormatPlain
objMail.Body = .Range("B2").Value

objMail..Display
End With

Set objOutlook = Nothing
MsgBox "送信完了"

End Sub

Answer 1

とりあえず作ってみました。
C列にヒットしたら、同じ行のD、E列のメールアドレスを使うという解釈でいいんですよね。

Private Sub CommandButton1_Click()
    Set myRange = ActiveSheet.Range("C10:C100")
    Set rngSearch = myRange.Find(What:=TextBox1.Value, LookAt:=xlPart)
    
    'TextBox1の値が未入力の場合
    If TextBox1 = "" Then
        MsgBox "氏名を入力してください。"
        Exit Sub
    End If
    
    '検索で一致するものがない場合
    If rngSearch Is Nothing Then
        MsgBox "見つかりませんでした。"
        Exit Sub
    End If
    
    '検索結果から行数字を取得
    Dim rowNum As Integer
    rowNum = rngSearch.Row
    
    Dim objOutlook As Outlook.Application
    Dim objMail As Outlook.MailItem
    Dim wsMail As Worksheet
    
    'メール作成
    Set objOutlook = New Outlook.Application
    Set wsMail = ThisWorkbook.Sheets("送信内容")
    Set objMail = objOutlook.CreateItem(olMailItem)
    
    With wsMail
        'ToにSheet1シートの検索結果行と同じD列の値を設定
        objMail.To = Cells(rowNum, 4).Value
        'CCにSheet1シートの検索結果行と同じE列の値を設定
        objMail.CC = Cells(rowNum, 5).Value
        '件名に送信内容シートのB1の値を設定
        objMail.Subject = .Range("B1").Value
        objMail.BodyFormat = olFormatPlain
        '本文に送信内容シートのB2の値を設定
        objMail.Body = .Range("B2").Value
        'メール作成画面表示
        objMail.Display
    End With
    
    Set objOutlook = Nothing
    Set objMail = Nothing
    'MsgBox "送信完了"
End Sub

追記
メールアドレスの複数設定ですが、
Microsoft Outlookでメールアドレスを複数設定するやり方と同じで
セミコロンで区切ってメールアドレスを繋ぎます。
DとE列を繋げるならこんな感じです。

objMail.To = Cells(rowNum, 4).Value & ";" & Cells(rowNum, 5).Value

Comments

[zzz-.-zzz]

yureighost様

ご回答ありがとうございます。
このコードで問題なく理想の動きをしました。
大変勉強になりました。
ありがとうございました。

[zzz-.-zzz]

yureighost様

この度はありがとうございました。
問題無く動作しているのですが、
TOの送信先を増やす場合についてお聞きしたい事があります。
D列とE列をTO　F列をCCにする場合、E列のTOはどのように追加すれば宜しいでしょうか？
下記のコードだとE列のアドレスのみTOになりD列のアドレスはTOに入りません。
objMail.To = Cells(rowNum, 4).Value
objMail.To = Cells(rowNum, 5).Value
objMail.CC = Cells(rowNum, 6).Value

度重なる質問で申し訳ございませんが、ご回答頂けると幸いです。

[zzz-.-zzz]

yureighost様

ご回答ありがとうございます。
なるほど。Outlook の方式で書けば良かったのですね。
大変勉強になりました。ありがとうございます。