メール一括送信VBAのメーラーの変更

Sub Mail_workbook_Outlook_6()
'Working in 2000-2010
'This example send the last saved version of the Activeworkbook
Dim OutApp As Object
Dim OutMail As Object
Dim emailRng As Range, cl As Range
Dim sTo As String

Set emailRng = Worksheets("スクール生 (2)").Range("L3:L47,M44")

For Each cl In emailRng
sTo = sTo & ";" & cl.Value
Next

sTo = Mid(sTo, 2)

Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)

On Error Resume Next
With OutMail
.To = sTo
.CC = "[e-mail]"
.BCC = ""
.Subject = "RMA #" & Worksheets("RMA").Range("E1")
.Body = "Attached to this email is RMA #" & _
Worksheets("RMA").Range("E1") & _
". Please follow the instructions for your department included in this form."

'You can add other files also like this
'.Attachments.Add ("C:\test.txt")

.Display


End With
On Error GoTo 0

Set OutMail = Nothing
Set OutApp = Nothing
End Sub

というVBAを使ってメールを送っているのですが
起動するメーラーをoutlookからWindows Liveメールに変更できますか？
よろしくお願いいたします。

No.6 回答者： Qchan1962 回答日時： 2020/02/10 14:31

書き忘れました。

全く気が付かなかったのですが、、Rubyなのですね。。
何で迷い込んだか分かりませんが、、Excel　VBAと思い回答しておりました。
すみません。

No.5 回答者： Qchan1962 回答日時： 2020/02/10 14:27

こんにちは、

＞そのコードを教えていただきたいです。
ほぼ、＃４のものです。
アドレスの抽出部分は違いますが、、、
また、送信結果をメールで
　　　　Mail_To = "*******@yahoo.co.jp"
　　　　Mail_Body = "全送付先アドレス" & vbCrLf & Full_list & vbCrLf & "通知内容" & vbCrLf & Mail_Body
　　　　Call OL_SendEmail(Mail_To, Mail_Cc, Mail_Body, Mail_Subject)
送るところも違います。その部分は、データとしてCSV出力しています。

この送る作業の前に、リスト作成などのVBAもありますし、Bodyの初めには、
　　　　　　Mail_Body = Tgt.Offset(, -3).Value & vbCrLf & _
　　　　　　　　　　　　Tgt.Offset(, -2).Value & " " & _
　　　　　　　　　　　　Tgt.Offset(, -1).Value & " 様" & vbCrLf & vbCrLf & _
　　　　　　　　　　　　wsMail.Range("B2").Value & wsMail.Range("B3").Value
と、法人名、名前、があり、本文、送り元情報が付きます。
ご希望なので、下記に（該当部分以外の処理は、削除しています。Setしたシート名を変更などして
該当セルに、添付図（縮小しています。）のような送信リストを作成すれば、そのまま使えるかもです。。
追記：書き方は、色々あると思います。変な書き方かもしれませんが、素人なので、勘弁してくださいね。

Option Explicit
Dim objOutlook As OutLook.Application
Sub SendEmail()
Dim j As Long, Tgt As Variant
Dim Mail_To As String, Mail_Cc As String, Mail_Body As String, Mail_Subject As String
Dim wsList As Worksheet: Set wsList = ThisWorkbook.Sheets("コントロール")
Dim wsMail As Worksheet: Set wsMail = ThisWorkbook.Sheets("メール本文")
Dim rc As Integer

　　rc = MsgBox("メール配信処理を行いますか？", vbYesNo + vbQuestion, "確認")
　　If rc = vbYes Then
　　　　j = 0
　　　　For Each Tgt In wsList.Range("D2:D" & wsList.Cells(Rows.Count, 4).End(xlUp).Row)
　　　　　　Mail_To = Tgt.Value　　　　'メール宛先
　　　　　　Mail_Cc = ""
　　　　　　Mail_Subject = wsMail.Range("B1").Value
　　　　　　Mail_Body = Tgt.Offset(, -3).Value & vbCrLf & _
　　　　　　　　　　　　Tgt.Offset(, -2).Value & " " & _
　　　　　　　　　　　　Tgt.Offset(, -1).Value & " 様" & vbCrLf & vbCrLf & _
　　　　　　　　　　　　wsMail.Range("B2").Value & wsMail.Range("B3").Value
　　　　　　Call OC_SendEmail(Mail_To, Mail_Cc, Mail_Body, Mail_Subject)
　　'他の処理あり
　　　　　　j = j + 1
　　　　Next Tgt
　　'他の処理あり
　　　　MsgBox j & "件　送信完了"
　　　　wsList.Range("H4") = Format(Now, "yyyymmdd")
　　　　If objOutlook Is Nothing Then Set objOutlook = Nothing
　　　　Set wsList = Nothing
　　　　Set wsMail = Nothing
　　End If
End Sub
Function OC_SendEmail(Mail_To As String, Mail_Cc As String, Mail_Body As String, Mail_Subject As String)
Dim objMail As OutLook.MailItem
　　Set objOutlook = New OutLook.Application
　　Set objMail = objOutlook.CreateItem(olMailItem)
　　With objMail
　　　　.To = Mail_To
　　　　.CC = Mail_Cc
　　　　.Subject = Mail_Subject
　　　　.BodyFormat = olFormatPlain　　 'メールの形式
　　　　.Body = Mail_Body
　　'　　　　.Display
　　　　.Send　'送信　Test時コメントにする
　　End With
　　Set objMail = Nothing
End Function

No.4 回答者： Qchan1962 回答日時： 2020/02/07 18:11

＃３続きです

②もう一つは、一通づつ送信して結果をCcに送信する。
Sub SendEmail_Test2()
Dim j As Long
Dim sTo As String
Dim Mail_To As String, Mail_Cc As String, Mail_Body As String, Mail_Subject As String
Dim cl As Range, rc As Integer, Full_list As String
　　rc = MsgBox("メール配信処理を行いますか？", vbYesNo + vbQuestion, "確認")
　　If rc = vbYes Then
　　　　j = 0
　　　　Mail_Body = "Attached to this email is RMA #" & _
　　　　　　　　　　Worksheets("RMA").Range("E1") & _
　　　　　　　　　　". Please follow the instructions for your department included in this form."
　　　　Mail_Subject = "RMA #" & Worksheets("RMA").Range("E1")

　　　　For Each cl In Worksheets("スクール生 (2)").Range("L3:L47,M44")
　　　　　　Mail_To = cl.Value
　　　　　　Mail_Cc = ""
　　　　　　Call OL_SendEmail(Mail_To, Mail_Cc, Mail_Body, Mail_Subject)
　　　　　　Full_list = Full_list & cl.Value & "; "
　　　　　　j = j + 1
　　　　Next
　　　　Mail_To = "[e-mail]"
　　　　Mail_Body = "全送付先アドレス" & vbCrLf & Full_list & vbCrLf & "通知内容" & vbCrLf & Mail_Body
　　　　Call OL_SendEmail(Mail_To, Mail_Cc, Mail_Body, Mail_Subject)
　　　　MsgBox j & "件　送信完了"
　　End If
End Sub

'SendEmail_Test2で使う
Function OL_SendEmail(Mail_To As String, Mail_Cc As String, Mail_Body As String, Mail_Subject As String)
Dim objOutlook As OutLook.Application
Dim objMail As OutLook.MailItem
　　Set objOutlook = New OutLook.Application
　　Set objMail = objOutlook.CreateItem(olMailItem)
　　With objMail
　　　　.To = Mail_To
　　　　.cc = Mail_Cc
　　　　.Subject = Mail_Subject
　　　　.BodyFormat = olFormatPlain　　　　　　　　'メールの形式
　　　　.Body = Mail_Body
　　　　.Display
　　'　　　　　　　　.Send
　　End With
　　Set objMail = Nothing
End Function

こんな回答していると叱られるかな。すみません。

No.3 回答者： Qchan1962 回答日時： 2020/02/07 18:10

こんにちは、Windows live mailは、VBAによる操作サポートはないようです。

WindowsAPIで起動して、、とか考えても難しいのではないでしょうか？
（出来るとは思いますが、、Windows live mail　環境がないので検証できません。）

デフォルトメーラーにWindows live mailを設定すれば、一度の起動の設定を
飛ばす事は出来そうですが、ExcelのHyperlinksをかえして実行するくらいしか思い浮かびません。
その場合、検証できませんが、こんな感じ？
Option Explicit
Sub test()
Dim Mail_To As String, Mail_Cc As String
Dim Mail_Body As String, Mail_Subject As String
Dim emailRng As Range, cl As Range
Dim sTo As String
Set emailRng = Worksheets("スクール生 (2)").Range("L3:L47,M44")
For Each cl In emailRng
sTo = sTo & ";" & cl.Value
Next
sTo = Mid(sTo, 2)
Mail_To = sTo
Mail_Cc = "[e-mail]"
Mail_Body = "Attached to this email is RMA #" & _
Worksheets("RMA").Range("E1") & _
". Please follow the instructions for your department included in this form."
Mail_Subject = "RMA #" & Worksheets("RMA").Range("E1")
Worksheets("Sheet1").Activate
　　With ActiveSheet
　　　　.Range("A1").Select
　　　　.Hyperlinks.Add _
　　　　　　　　Anchor:=Selection, _
　　　　　　　　Address:="mailto:?" & _
　　　　　　　　"to=" & Mail_To & _
　　　　　　　　"&cc=" & Mail_Cc & _
　　　　　　　　"&body=" & Mail_Body & _
　　　　　　　　"&subject=" & Mail_Subject, _
　　　　　　　　TextToDisplay:="Test"
　　　　.Hyperlinks(1).Follow
　　　　.Hyperlinks.Delete
　　　　.Range("A1").Clear
　　End With
End Sub

しかし、コードにある
Set emailRng = Worksheets("スクール生 (2)").Range("L3:L47,M44")
For Each cl In emailRng
sTo = sTo & ";" & cl.Value
Next
がネックになりそうですね。（文字数制限など）
もし、この問題がWindows live mailに変更しようとする動機なら、処理プロセス自体を
再構築しては、いかがでしょう。

的違いなら、忘れてください。
私の作成したツールでも毎月、同時？に150人以上にOutlookで配信するVBAがあります。
ただ、ご質問の場合だと一々Ccが送信されてしまいますね。

①そこで、送信アドレス文字数を200文字程度に分けて送信する。多分、6～9通くらいになるか～？
②もう一つは、一通づつ送信して結果をCcに送信する。

趣味の範疇なので作ってみました。
参考に成らないかも知れませんし、表題からずれてますね。スレッド汚しですみません。

Sub SendEmail_Test1()
Dim objOutlook As OutLook.Application
Dim i As Long, j As Long
Dim objMail As OutLook.MailItem
Dim Mail_Body As String, Mail_Subject As String
Dim cl As Range, sTo As String, MyLen As Long
Dim rc As Integer, arrTo()
　　rc = MsgBox("メール配信処理を行いますか？", vbYesNo + vbQuestion, "確認")
　　If rc = vbYes Then
　　　　Set objOutlook = New OutLook.Application
　　　　i = 0
　　　　MyLen = 200
　　　　ReDim arrTo(i)
　　　　For Each cl In Worksheets("スクール生 (2)").Range("L3:L47,M44")
　　　　　　If Len(sTo) <= MyLen Then
　　　　　　　　sTo = sTo & ";" & cl.Value
　　　　　　　　arrTo(i) = sTo
　　　　　　Else
　　　　　　　　arrTo(i) = sTo & ";" & cl.Value
　　　　　　　　sTo = ""
　　　　　　　　i = i + 1
　　　　　　　　ReDim Preserve arrTo(i)
　　　　　　End If
　　　　Next
　　　　Mail_Subject = "RMA #" & Worksheets("RMA").Range("E1")
　　　　Mail_Body = "Attached to this email is RMA #" & _
　　　　　　　　　　Worksheets("RMA").Range("E1") & _
　　　　　　　　　　". Please follow the instructions for your department included in this form."
　　　　j = 0
　　　　For i = 0 To UBound(arrTo) - 1
　　　　　　Set objMail = objOutlook.CreateItem(olMailItem)
　　　　　　With objMail
　　　　　　　　.To = arrTo(i)　　　 'メール宛先
　　　　　　　　.cc = "[e-mail]"
　　　　　　　　.Subject = Mail_Subject　　　　'メール件名
　　　　　　　　.BodyFormat = olFormatPlain　　　　'メールの形式
　　　　　　　　.Body = Mail_Body　　　　 'メール本文
　　　　　　　　.Display
　　'　　　　　　　　.Send
　　　　　　End With
　　　　　　j = j + 1
　　　　　　Set objMail = Nothing
　　　　Next i
　　　　MsgBox j & "　送信完了"
　　　　Set objOutlook = Nothing
　　End If
End Sub

オーバーしてしまうようなので、続きを次に

この回答へのお礼

ありがとうございます。
>私の作成したツールでも毎月、同時？に150人以上にOutlookで配信するVBAがあります。
すごいですね！
私は全くの初心者なんで
そのコードを教えていただきたいです。
よろしくお願いいたします。

お礼日時：2020/02/10 11:38

No.2 回答者： GooUserラック 回答日時： 2020/02/05 15:37

既定のアプリを VBA で変更するとなると探し切れていないのかもしれませんが無いようです。

他の方の回答をお待ちください。

この回答へのお礼

了解しました。
どうもありがとうございます。

お礼日時：2020/02/05 17:35

No.1 回答者： GooUserラック 回答日時： 2020/02/05 15:03

普段使うメーラーをWindows Liveメールに事前で変えておけばWindows Liveメールになります。

VBA で指定したいという事でしょうか？

この回答へのお礼

ありがとうございます。
VBAで指定できませんか？
教えていただけたら幸いです。

お礼日時：2020/02/05 15:09