Question

我每天都有一份报告需要发送给某些管理员。问题在于并非总是提到每个管理员，并且提到的管理员经常出现多次。再加上我的行数总是可变的。

它通常看起来像这样：

我想发生的事情是，向提到的每个管理员生成一封电子邮件。到目前为止，这是我的公司的电子邮件地址设置为“ first.last@email.email”）。

Sub Email_Test()

Columns("F:F").Select
Selection.Replace What:=" ", Replacement:=".", LookAt:=xlPart, _
    SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
    ReplaceFormat:=False

With Application
    .EnableEvents = False
    .ScreenUpdating = False
End With

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

On Error Resume Next
With OutMail
.Display
End With
    signature = OMail.body
With OutMail
    .To = Range("F2") & "@email.email" & "; " & Range("F3") & "@email.email" & "; " & Range("F4") & "@email.email" & "; " & Range("F5") & "@email.email" & "; " & Range("F6") & "@email.email"
    .CC = ""
    .BCC = ""
    .Subject = "Report"
    .HTMLBody = "See attached" & "<br>" & .HTMLBody
    .Attachments.Add ActiveWorkbook.FullName
    .DeferredDeliveryTime = ""
    .Display
End With
On Error GoTo 0

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

Set OutMail = Nothing
Set OutApp = Nothing

End Sub

显然这是行不通的，但希望它能说明我的想法。我有什么办法可以在F列中搜索名称的每个唯一实例，然后添加电子邮件扩展名？我敢肯定，现在的方式比我现在要复杂得多。

谢谢！

Answer 1

因此，首先，从名称列表中猜测电子邮件地址确实很危险。（您确定没有两个Paul Blarts吗？如果是，则只有一个正在获取报告。您确定没有两个Tony睡衣吗？如果是，则是正确的一个正在获取报告吗？）无论如何，我认为您已经考虑了所有这些问题，并且如果选择了错误的睡衣，就可以继续工作。

我将使用scripting.dictionary使用名称或电子邮件地址作为密钥来保存电子邮件。然后我可以在添加另一个之前测试该字典的成员资格：

未经测试，但应该给您一个指导意见：

Public Sub CreateEmails()
    Dim row As Long
    Dim email_address As String
    Dim email_dict As Object
    Set email_dict = CreateObject("Scripting.Dictionary")

    Set OutApp = CreateObject("Outlook.Application")
    Dim OutMail As Object

    row = 2
    Do While ThisWorkbook.Sheets("SheetWithNames").Cells(row, 6).Value <> ""
        email_address = email_address_from_name(.Cells(row, 6).Value) 'turns a name into an email
        If Not email_dict.exists(email_address) Then
            Set OutMail = OutApp.CreateItem(0)
            With OutMail
                .To = email_address
                .Subject = "Report"
                .HTMLBody = "See attached" & "<br>" & .HTMLBody
                .Attachments.Add ActiveWorkbook.FullName
                .Display
            End With
            email_dict.Add email_address, OutMail
        End If
        row = row + 1
    Loop
End Sub

Excel VBA在列中向不同的人发送电子邮件

1 个答案: