使用VBA从excel表格创建outlook电子邮件并发送给多个收件人

我在寻求帮助

我是VBA编码的初学者

我在一张纸上有几个表格，用于识别不同的电子邮件组。由于不同的情况，电子邮件将发送到不同的组

我尝试使用ListObject从表中提取电子邮件，但似乎不起作用，并在收件人中显示0，而不是电子邮件列表。我的想法是通过定位表列标题名“Email”来提取电子邮件

下面显示了其中一个表和我的代码。（电子邮件是伪造的）

幸运的是，问题解决了，下面请查看使用

TextJoin

的解决方案

Sub SdGroupEmail()

Application.ScreenUpdating = False
Dim email_group As Worksheet
Set email_group = ThisWorkbook.Worksheets("Email Groups")

Dim OutApp As Object
Dim OutMail As Object

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

Dim emails As String

    On Error Resume Next
    
    With OutMail

    emails = WorksheetFunction.TextJoin(";", True, email_group.ListObjects("Included_everytime").ListColumns("Email").DataBodyRange)
    
        .SentOnBehalfOfName = "abc@outlook.com"
        .To = emails
        .CC = ""
        .BCC = ""
        
        .display

    End With

    On Error GoTo 0

    With Application
        .EnableEvents = True
        .ScreenUpdating = True
    End With

    Set OutMail = Nothing
    Set OutApp = Nothing


End Sub

---

我正在寻求帮助甚至Excel都想帮助您，但您告诉Excel某种程度上“闭嘴”：）在“错误恢复下一步”中注释行
，然后运行代码。如果对该行进行注释，您会注意到错误发生在
emails=email\u group.ListObjects（“表1”）.ListColumns（“email”）.DataBodyRange.Values
行。问题在于
值
。应该是
.Value
非常感谢先生！但是，我更改了代码，但收件人框中仍然没有显示电子邮件。我可以知道有什么建议可以帮助解决标题问题吗？@BryanL:您的代码仍然包含错误恢复下一步的
。如果你删除它，你会有任何错误吗？@Heinzi谢谢你的提醒！发现行“emails=email\u group.ListObjects（“表1”）.ListColumns（“email”）.DataBodyRange.Value”存在类型不匹配问题。我该怎么办？那一栏你有什么错误吗？例如
#DIV/0或
#不适用
？
Sub SdGroupEmail()

Application.ScreenUpdating = False
Dim email_group As Worksheet
Set email_group = ThisWorkbook.Worksheets("Email Groups")

Dim OutApp As Object
Dim OutMail As Object

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

Dim emails As String

    On Error Resume Next
    
    With OutMail

    emails = WorksheetFunction.TextJoin(";", True, email_group.ListObjects("Included_everytime").ListColumns("Email").DataBodyRange)
    
        .SentOnBehalfOfName = "abc@outlook.com"
        .To = emails
        .CC = ""
        .BCC = ""
        
        .display

    End With

    On Error GoTo 0

    With Application
        .EnableEvents = True
        .ScreenUpdating = True
    End With

    Set OutMail = Nothing
    Set OutApp = Nothing


End Sub