VBAでメール作成（選択した複数の宛先へのメール作成） ExcelのVBAを使用してOutlookの

VBAでメール作成（選択した複数の宛先へのメール作成）

ExcelのVBAを使用してOutlookのメールを作成したいのですが、初心者のため上手く動きません。
想定している動作は別シート("メールアドレス")に入力し
てあるアドレスをインボックスで複数選択しそのアドレスを宛先に追加したいです。
以前このサイト上に教えてもらいトライしたのですが、
連番セルしかカウントできないため
飛びセルを選択してしまうと異なったアドレスをコピーしてしまいます。


詳しい方いらっしゃいましたらご教示ください。


Sub Cbm_Value_Select()
    Dim rng As Range
    Dim MM As String, M As String, N As String
    Dim outlookObj As Outlook.Application
    Set outlookObj = New Outlook.Application
    Dim mailObj As Outlook.MailItem
    Set mailObj = outlookObj.CreateItem(olMailItem)

    Set rng = Application.InputBox(Prompt:="ｱﾄﾞﾚｽ選択して下さい", Type:=8) 'ｱﾄﾞﾚｽ選択

    If Not rng.Cells.Count > 0 Then Exit Sub
    MM = ProcessingFuc(rng, rng.Cells.Count)
    MM = Right(MM, Len(MM) - 1) 'アドレスが加工され変数に代入

    M = Worksheets("ﾒｰﾙ内容").Cells(5, 2) '件名　選択
    N = Worksheets("ﾒｰﾙ内容").Cells(9, 2) '本文　選択
   'メール送信内容の作成
   With mailObj
     .To = MM 'メール宛先
     .Subject = M 'メール件名
     .Body = N  'メール本文
     .BodyFormat = olFormatPlain     'メール形式に設定
     .Display
   End With
End Sub

No.3 ベストアンサー 回答者： Qchan1962 回答日時： 2020/03/21 00:54

ろくに検証もせずに回答し余計な手数をおかけして申し訳ありません。

検証しましたが、下記でどうでしょうか？
Functionは要りません。

Sub Cbm_Value_Select()
Dim outlookObj As Outlook.Application
Dim mailObj As Outlook.MailItem
Dim rng As Range, arrAd As Object
Dim MM 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)
　　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)　　'アドレスが加工され変数に代入されます。
　　M = Worksheets("ﾒｰﾙ内容").Cells(5, 2)　　'件名　選択
　　n = Worksheets("ﾒｰﾙ内容").Cells(9, 2)　　'本文　選択
　　'メール送信内容の作成
　　With mailObj
　　　　.To = MM　　　　　　 'メール宛先
　　　　.Subject = M　　　　 'メール件名
　　　　.Body = n　　　　　　'メール本文
　　　　.BodyFormat = olFormatPlain　　'メール形式に設定
　　　　.Display
　　End With
End Sub

この回答へのお礼

回答ありがとうございます！
無事できました！
ありがとうございました！

お礼日時：2020/03/22 08:38

No.2 回答者： Qchan1962 回答日時： 2020/03/20 22:24

こんばんは、下記も書き換えましたか？

Function ProcessingFuc(arrAd As Variant, n As Long) As String
Dim i As Long
　　arrAd = Split(arrAd, ",")
　　　For i = 0 To n - 1
　　　　ProcessingFuc = ProcessingFuc & "; " & Range(arrAd(i)).Value
　　　Next
End Function

この回答へのお礼

こんばんは。
はい。書き換えたのですが
逆に宛先に何も表示されない状態でした。
メール画面が出るのですが。。
あと、セルを連続指定すると逆にエラーになりました。

お礼日時：2020/03/20 23:27

No.1 回答者： Qchan1962 回答日時： 2020/03/19 14:04

前回回答しましたコードは飛び行には、対応していませんでしたね。

すみません。

前回のものを改造しましたので、こちらでどうでしょうか

Sub Cbm_Value_Select()
Dim rng As Range, MM As String
Dim arrAd
Set rng = Application.InputBox(Prompt:="ｱﾄﾞﾚｽ選択して下さい", Type:=8)
If Not rng.Cells.Count > 0 Then Exit Sub
MM = ProcessingFuc(rng.Address, rng.Cells.Count)
MM = Right(MM, Len(MM) - 1) 'アドレスが加工され変数に代入されます。
End Sub
Function ProcessingFuc(arrAd As Variant, n As Long) As String
Dim i As Long
arrAd = Split(arrAd, ",")
For i = 0 To n - 1
ProcessingFuc = ProcessingFuc & "; " & Range(arrAd(i)).Value
Next
End Function

この回答へのお礼

回答ありがとうございます。
上記コードでトライしましたが
宛先にアドレスが表示されなくなりました。
因みにコードは下記の通りです。

Sub Cbm_Value_Select()

    Dim rng As Range

    Dim MM As String, M As String, n As String

    Dim arrAd

    Dim outlookObj As Outlook.Application

    Set outlookObj = New Outlook.Application

    Dim mailObj As Outlook.MailItem

    Set mailObj = outlookObj.CreateItem(olMailItem)

    Set rng = Application.InputBox(Prompt:="ｱﾄﾞﾚｽ選択して下さい", Type:=8)

   

     If Not rng.Cells.Count > 0 Then Exit Sub

    MM = ProcessingFuc(rng.Address, rng.Cells.Count)

    MM = Right(MM, Len(MM) - 1)  'アドレスが加工され変数に代入されます。

    M = Worksheets("ﾒｰﾙ内容").Cells(5, 2) '件名　選択

    n = Worksheets("ﾒｰﾙ内容").Cells(9, 2) '本文　選択

   'メール送信内容の作成

   With mailObj

     .To = MM 'メール宛先

     .Subject = M 'メール件名

     .Body = n  'メール本文

     .BodyFormat = olFormatPlain     'メール形式に設定

     .Display

   End With

   

End Sub

お礼日時：2020/03/20 11:41