如何使用Outlook将电子邮件发送到Excel VBA中的多个收件人 [英] How can I use Outlook to send email to multiple recipients in Excel VBA

问题描述

我正在Excel表单上设置几个按钮来发送不同的人群。我在单独的工作表上制作了几个单元格范围，以列出单独的电子邮件地址。例如，我想要按钮A打开Outlook，并将电子表B：单元格D3-D6中的电子邮件地址列表。然后，所有必须完成的都是在Outlook中点击发送。

I am trying to set up several buttons on an Excel form to email different groups of people. I made several ranges of cells on a separate worksheet to list the separate email addresses. For example, I want "Button A" to open Outlook and put the list of email addresses from "Worksheet B: Cells D3-D6". Then all that has to be done is hit "Send" in Outlook.

这是迄今为止的VBA代码，但我无法让它工作。有人可以告诉我我失踪或做错了吗？

Here is my VBA code so far, but I can't get it to work. Can someone tell me what I'm missing or doing wrong, please?

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 = "[e-mail];[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." 
        .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 

推荐答案

您必须循环遍历范围内的每个单元格D3：D6并构造您的到字符串。简单地将其分配给变体将不能解决目的。如果直接将范围分配给它，则 EmailTo 将成为一个数组。你也可以这样做，但是你必须循环遍历数组来创建你的 To string

You have to loop through every cell in the range "D3:D6" and construct your To string. Simply assigning it to a variant will not solve the purpose. EmailTo becomes an array if you assign the range directly to it. You can do this as well but then you will have to loop through the array to create your To string

是这是你在想什么？ （ TRIED AND TESTED ）

Is this what you are trying? (TRIED AND TESTED)

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 = "[e-mail];[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."
        .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

这篇关于如何使用Outlook将电子邮件发送到Excel VBA中的多个收件人的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！