Excel VBA Outlookﾒｰﾙ作成について

Outlook　VBAﾒｰﾙ作成方法について教えて下さい。
下記ｺｰﾄﾞにて問題なくﾒｰﾙ作成はできるのですが
ｱﾄﾞﾚｽ選択時（宛先＋CC）にInputboxを使用しているため①ﾏｳｽｽｸﾛｰﾙ②ﾌｨﾙﾀｰが操作できず不便です。。
ﾕｰｻﾞｰﾎｰﾑならﾏｳｽｽｸﾛｰﾙを操作できることは知っているのですが
①②を満たせるﾏｸﾛを作成することは可能でしょうか？

因みに①を使用したい理由は
ｱﾄﾞﾚｽ帳から選択しやすくするためです。
②を使用したい理由は
ｱﾄﾞﾚｽ帳から検索する際にｸﾞﾙｰﾌﾟ分けしているため
ﾌｨﾙﾀｰを使用したいためです。

お手数おかけしますがご教示お願いします。


Sub メール送信宛先CC()

Dim outlookObj As Outlook.Application
Dim mailObj As Outlook.MailItem
Dim rng, rng2 As Range, arrAd As Object
Dim MM, NN As String, M As String, n As String

Set outlookObj = New Outlook.Application
Set mailObj = outlookObj.CreateItem(olMailItem)
Set rng = Application.InputBox(Prompt:="宛先ｱﾄﾞﾚｽ選択して下さい", Type:=8)
Set rng2 = Application.InputBox(Prompt:="CCｱﾄﾞﾚｽ選択して下さい", Type:=8)
If Not rng.Cells.Count > 0 Then Exit Sub
For Each arrAd In rng 'Range内（配列）に対して
MM = MM & "; " & arrAd.Value
Next
MM = Right(MM, Len(MM) - 1) 'アドレスが加工され変数に代入
If Not rng2.Cells.Count > 0 Then Exit Sub
For Each arrAd In rng2 'Range内（配列）に対して
NN = NN & "; " & arrAd.Value
Next
NN = Right(NN, Len(NN) - 1) 'アドレスが加工され変数に代入
M = Worksheets("ﾒｰﾙ内容").Cells(5, 2) '件名　選択
n = Worksheets("ﾒｰﾙ内容").Cells(9, 2) '本文　選択
'メール送信内容の作成
With mailObj
.To = MM 'メール宛先
.CC = NN 'メールCC
.Subject = M 'メール件名
.Body = n 'メール本文
.BodyFormat = olFormatPlain 'メール形式に設定
.Display
End With
End Sub

No.3 ベストアンサー 回答者： Qchan1962 回答日時： 2020/04/12 23:17

追記が無かったので他の方法を模索されているのかな？と思っていました。

>Label2.Caption.Value = ""　コードにて削除可能でしょうか？
はい。

もうUserForm作られました？

#2で書いたのですが、イマイチ使いにくそうなので書き直してしまいました。（望んではいないと思いますが）
UserForm2になっていますが、これも押し売りで示します。

UserForm2は1に書き換えて、、UserForm2の配置は添付図で

必ず　UserForm2.Show vbModeless　で表示してください。
Label2.Caption、Label3.Caption　をクリックすると変数を含め内容がなくなり
再度、選択するようになります。また、CheckBoxがONならCCからでも選択できます。

ボタンは1つで必ずCCが必要か分からなかったのでCheckBoxにしました。
各Caption は表示の時に設定されます。

丹念に読めば多分わかると思いますので
配置、フォントなどお好みで設定して仕様に合わせて各所（処理など）変更してください。
標準モジュール可
Sub sample()
UserForm2.Show vbModeless
End Sub
フォームモジュール
Option Explicit
Dim arrAd As Object
Dim rng As Range, rng2 As Range
Dim MM As String, NN As String, M As String, N As String
Private Sub UserForm_Initialize()
　　Frame1.Caption = "宛先アドレス"
　　Frame2.Caption = "CCアドレス "
　　Label1.Caption = "宛先アドレスを選択してください。"
　　Label2.Caption = ""
　　Label3.Caption = ""
　　CheckBox1.Caption = "CCアドレスOFF"
　　CommandButton1.Caption = "宛先選択"
　　UserForm2.Caption = "一斉メール　選択フォーム"
　　CheckBox1 = False
　　Frame2.Enabled = False
End Sub
Private Sub CommandButton1_Click()
　　If CommandButton1.Caption = "宛先選択" Then
　　　　For Each arrAd In Selection
　　　　　　MM = MM & "; " & arrAd
　　　　Next
　　　　MM = Right(MM, Len(MM) - 2)　　'アドレスが加工され変数に代入
　　　　Label2.Caption = Replace(MM, "; ", vbCrLf)
　　　　If CheckBox1 = True Then
　　　　　　Label1.Caption = "CCアドレス　選択してCC抽出ボタンを押して下さい"
　　　　　　CommandButton1.Caption = "CC選択"
　　　　Else
　　　　　　Label1.Caption = "メール作成ボタンを押して下さい"
　　　　　　CommandButton1.Caption = "メール作成"
　　　　End If
　　　　If NN <> "" Then
　　　　　　Label1.Caption = "メール作成ボタンを押して下さい"
　　　　　　CommandButton1.Caption = "メール作成"
　　　　End If
　　　　Exit Sub
　　End If
　　If CommandButton1.Caption = "CC選択" Then
　　　　For Each arrAd In Selection　　'Range内（配列）に対して
　　　　　　NN = NN & "; " & arrAd.Value
　　　　Next
　　　　NN = Right(NN, Len(NN) - 1)　　'アドレスが加工され変数に代入
　　　　Label3.Caption = Replace(NN, "; ", vbCrLf)
　　　　Label1.Caption = "メール作成ボタンを押して下さい"
　　　　CommandButton1.Caption = "メール作成"
　　　　Exit Sub
　　End If
　　If CommandButton1.Caption = "メール作成" Then
　　　　Dim outlookObj As Outlook.Application
　　　　Dim mailObj As Outlook.MailItem
　　　　Set outlookObj = New Outlook.Application
　　　　Set mailObj = outlookObj.CreateItem(olMailItem)
　　　　M = Worksheets("ﾒｰﾙ内容").Cells(5, 2)　　'件名　選択
　　　　N = Worksheets("ﾒｰﾙ内容").Cells(9, 2)　　'本文　選択
　　'メール送信内容の作成
　　　　With mailObj
　　　　　　.To = MM　　　　 'メール宛先
　　　　　　.CC = NN　　　　 'メールCC
　　　　　　.Subject = M　　 'メール件名
　　　　　　.Body = N　　　　'メール本文
　　　　　　.BodyFormat = olFormatPlain　　'メール形式設定
　　　　　　.Display
　　　　End With
　　　　Unload Me
　　End If
End Sub
Private Sub CheckBox1_Click()
　　If CheckBox1 = True Then
　　　　Frame2.Enabled = True
　　　　CheckBox1.Caption = "CCアドレスON"
　　Else
　　　　Frame2.Enabled = False
　　　　CheckBox1.Caption = "CCアドレスOFF"
　　　　NN = ""
　　　　Label3.Caption = ""
　　End If
End Sub
Private Sub Label2_Click()
　　Label2.Caption = ""
　　MM = ""
　　CommandButton1.Caption = "宛先選択"
　　Label1.Caption = "宛先アドレスを選択してください。"
End Sub
Private Sub Label3_Click()
　　If CheckBox1 = True Then
　　　　NN = ""
　　　　Label3.Caption = ""
　　　　CommandButton1.Caption = "CC選択"
　　　　Label1.Caption = "CCアドレス　選択してCC抽出ボタンを押して下さい"
　　End If
End Sub

この回答へのお礼

お返事遅くなりすいません。
押し売り最高です。
ありがとうございます。感謝です。
UserFormは作りました！
実際使ってみて感動でした。
今回のコードも是非とも使わさせていただきます！

お礼日時：2020/04/13 00:08

No.2 回答者： Qchan1962 回答日時： 2020/04/10 00:34

Application.InputBoxでなくUserFormで同様の処理をするものを書いときますね。

押し売りですが、
ただ、UserFormはコードに合わせ作成してください。
コードを読み理解すれば、UserFormを作る事は出来ると思いますので、、

Sub Test()　’ここからUserForm1を呼び出す
UserForm1.Show vbModeless
End Sub

Option Explicit
Dim arrAd As Object
Dim rng As Range, rng2 As Range
Dim MM As String, NN As String, M As String, N As String
Private Sub CommandButton1_Click()
　　For Each arrAd In Selection
　　　　MM = MM & "; " & arrAd
　　Next
　　MM = Right(MM, Len(MM) - 2)　　'アドレスが加工され変数に代入
　　Label2.Caption = Replace(MM, "; ", vbCrLf)
　　Label1.Caption = "CCアドレス　セルを選択してCC抽出ボタンを押して下さい"
End Sub

Private Sub CommandButton2_Click()
　　If Label2.Caption = "" Then MsgBox ("宛先アドレスを設定してください。"): Exit Sub　’作成時プロパティ設定確認
　　For Each arrAd In Selection　 'Range内（配列）に対して
　　　　NN = NN & "; " & arrAd.Value
　　Next
　　NN = Right(NN, Len(NN) - 1)　　'アドレスが加工され変数に代入
　　Label3.Caption = Replace(NN, "; ", vbCrLf)
　　Label1.Caption = "メール作成ボタンを押して下さい"
End Sub

Private Sub CommandButton3_Click()
　　If Label2.Caption = "" Then MsgBox ("宛先アドレスを設定してください。"): Exit Sub
　　Dim outlookObj As Outlook.Application
　　Dim mailObj As Outlook.MailItem
　　Set outlookObj = New Outlook.Application
　　Set mailObj = outlookObj.CreateItem(olMailItem)
　　M = Worksheets("ﾒｰﾙ内容").Cells(5, 2)　　'件名　選択
　　N = Worksheets("ﾒｰﾙ内容").Cells(9, 2)　　'本文　選択
　　'メール送信内容の作成
　　With mailObj
　　　　.To = MM　　　　　　 'メール宛先
　　　　.CC = NN　　　　　　 'メールCC
　　　　.Subject = M　　　　 'メール件名
　　　　.Body = N　　　　　　'メール本文
　　　　.BodyFormat = olFormatPlain　　'メール形式設定
　　　　.Display
　　End With
　　Unload Me
End Sub
Private Sub UserForm_Initialize()
Label1.Caption = "宛先アドレス　セルを選択して宛先抽出ボタンを押して下さい"
End Sub

～Caption　部分はメイン処理にはすべてなくとも影響しません。
案内と表示しているだけなので、、、
あ、If Label2.Caption = "" Then MsgBox ("宛先アドレスを設定してください。"): Exit Sub
ここは、入力確認してました。。

一応実行時の参考画像を添付しますので
試してみてください。

この回答へのお礼

回答ありがとうございます！
コードまで書いていただき感謝です！
一つ質問なんですが、label内に書いてしまった内容は以下のコードにて削除可能でしょうか？
Label2.Caption.Value = ""

お礼日時：2020/04/12 21:41

No.1 回答者： Qchan1962 回答日時： 2020/04/08 14:21

手直しされたようですが、変数のところは、またと言う感じですね。

ところで、　＞ｱﾄﾞﾚｽ帳
シートに書いているものを指しているのですか？恐らくそうですよね。
実行途中でフィルタをかける場合やかけない場合など、、、

ユーザーフォームにリストボックスを設置して操作した方が良さそうです。その場合、
詳しいシートの配置、フィルタをかける列、などなど分からないとユーザーフォーム作成のアドバイスは難しいかと思います。

が、出来るだけ掲示のコードの状態で②ﾌｨﾙﾀｰが操作を出来るように変えたいと言う事であれば、最善かどうかは、、分かりませが

実行部分を、標準モジュールとフォームモジュールに分けて　宛先ｱﾄﾞﾚｽ選択を行ったと　UserForm1.Show vbModeless　で
②ﾌｨﾙﾀｰが操作　ボタンを押して　CCｱﾄﾞﾚｽ選択　＞＞メール作成　のようにすれば出来ると思います。

しかし、ユーザーフォームを作り込んだ方が良いと思いますよ

①ﾏｳｽｽｸﾛｰﾙ　これは出来ないですか？　やっぱりシートで無いのかな？

追記：掲示のコードエラー出ませんか？選択した後キャンセルすると、、、
On Error Resume Next　で　エラーの　Set rng～　を飛ばし　
　If Not rng.Cells.Count > 0 Or Err.Number <> 0 Then
　　Exit Sub
　End If
のように対策された方がよいかとおもいます。