Question

我正在尝试创建一个VBA代码，该代码将电子邮件发送到E列中的电子邮件地址列表。我在E栏中的电子邮件如下所示：

abc@email.com
123@email.com
<Blank Cell>
pop3@email.com
<Blank Cell>
email@test.com

这是我的代码：

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

If Not Intersect(Target, Range("M2")) Is Nothing And Range("M2").Value = "Send Prospect Alerts" Then

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

    strbody = "This is an email"

    On Error Resume Next


    With OutMail
        .To = Range("E6:E100").Value
        .CC = ""
        .BCC = ""
        .Subject = "Sales Connect Tracker: A Task has been completed"
        .HTMLBody = strbody            'You can add a file like this
        .Send 'displays outlook email
        'Application.SendKeys "%s" 'presses send as a send key
    End With
    On Error GoTo 0

    Set OutMail = Nothing
    Set OutApp = Nothing

MsgBox "Email Sent"

End If
End Sub

目前我正在尝试在电子邮件“TO”字段中引用我的范围E6：E100，但这不起作用，也没有发送电子邮件。

我只能假设这是因为电子邮件地址显示如下：

 abc@email.com123@email.com<Blank Cell>pop3@email.com<Blank Cell>email@test.com

Outlook需要将电子邮件分开，如：

abc@email.com; 123@email.com; <Blank Cell>; pop3@email.com; <Blank Cell>; email@test.com

另外正如您可能注意到的那样，电子邮件地址之间有一些空白单元格，我不确定这是否会被视为问题，好像没有电子邮件地址，那么它应该只是忽略空白细胞

所以我的问题基本上是如何让这个工作并将我的电子邮件发送到我的专栏E中的所有电子邮件地址？

请有人告诉我我哪里出错了，谢谢

Answer 1

输入范围或数组时，它根本不知道该怎么做......但它会尝试将.To设置为它。虽然.To只接受字符串。

要得到这个：

abc@email.com; 123@email.com; pop3@email.com; email@test.com

试试这个：

Function getMailList(rng As Range) As String
  Dim str As String, i As Variant
  For Each i In rng
    If Len(i.Value) > 0 Then If Len(str) = 0 Then str = i Else str = str & "; " & i
  Next
  getMailList = str
End Function

并更改

.To = Range("E6:E100").Value

到

.To = getMailList(Range("E6:E100"))

For Each ... in ...只返回设定范围中的每个项目 If项目的长度不为0（可以检查isempty，但对""} Then返回false If您的输出（str）为空Then将其设置为项目（i）Else添加", "并将项目设置为< / p>

编辑：啊哈哈......只是复制/粘贴错误...没有删除第一行中的<Blank Cell>：P

从列中获取所有非空值并转换为电子邮件列表

1 个答案: