web-dev-qa-db-ja.com

Outlookを使用してExcel VBAで複数の受信者に電子メールを送信する方法

異なるグループのユーザーにメールを送信するために、Excelフォームにいくつかのボタンを設定しようとしています。別のワークシートに複数のセル範囲を作成して、個別のメールアドレスをリストしました。たとえば、「ボタンA」でOutlookを開き、「ワークシートB：セルD3-D6」から電子メールアドレスのリストを配置します。次に、Outlookで[送信]をクリックするだけです。

ここに私のVBAコードがありますが、動作させることができません。誰かが私に欠けていることや間違っていることを教えてもらえますか？

VB：

Sub Mail_workbook_Outlook_1() 
     'Working in 2000-2010
     'This example send the last saved version of the Activeworkbook
    Dim OutApp As Object 
    Dim OutMail As Object 

    EmailTo = Worksheets("Selections").Range("D3:D6") 

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

    On Error Resume Next 
    With OutMail 
        .To = EmailTo 
        .CC = "[email protected];[email protected]" 
        .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." 
        .Attachments.Add ActiveWorkbook.FullName 
         '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
excelemailvbaoutlook
9
user2092180

"D3:D6"の範囲内のすべてのセルをループして、To文字列を作成する必要があります。単にバリアントに割り当てるだけでは、目的は解決しません。 EmailToは、範囲を直接割り当てると配列になります。これもできますが、配列をループしてTo文字列を作成する必要があります

これはあなたがしようとしていることですか？ （試行およびテスト済み）

Option Explicit

Sub Mail_workbook_Outlook_1()
     '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("Selections").Range("D3:D6")

    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 = "[email protected];[email protected]"
        .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."
        .Attachments.Add ActiveWorkbook.FullName
         '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
14
Siddharth Rout
ToAddress = "[email protected]"
ToAddress1 = "[email protected]"
ToAddress2 = "[email protected]"
MessageSubject = "It works!."
Set ol = CreateObject("Outlook.Application")
Set newMail = ol.CreateItem(olMailItem)
newMail.Subject = MessageSubject
newMail.RecipIents.Add(ToAddress)
newMail.RecipIents.Add(ToAddress1)
newMail.RecipIents.Add(ToAddress2)
newMail.Send
4
MD5