时间戳

首页 > 解决方案 > Excel VBA 向列中的不同人员发送电子邮件

excel - Excel VBA 向列中的不同人员发送电子邮件

问题描述

我有一份每天为我生成的报告，我需要将其发送给某些管理员。问题是并不是每个管理员都被提及，而且被提及的管理员经常出现多次。加上我拥有的行数总是可变的。

它通常看起来像这样：

列示例

我希望发生的是为提到的每个管理员生成一封电子邮件。到目前为止我所拥有的是（我公司的电子邮件地址设置为“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 列中搜索名称的每个唯一实例，然后添加电子邮件扩展名？我敢肯定，有一种比我目前所拥有的方式更简单的方式。

谢谢！

标签： excelvba

解决方案

因此，首先从姓名列表中猜测电子邮件地址是非常危险的。（你确定没有两个 Paul Blarts 吗？如果是这样，只有一个得到报告。你确定没有两个 Tony 睡衣吗？如果是这样，得到报告的那个是正确的吗？）无论如何，我假设你已经考虑了所有这些，如果穿错了睡衣，你就可以保住工作。

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

未经测试，但应该给你 jist：

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

推荐阅读