使用excel vba从OFT模板发送电子邮件

时间:2015-05-28 09:23:39

标签: excel vba email loops excel-vba

美好的一天 下面的代码根据其他列为A列中的每一行生成一个唯一的电子邮件+附件。

这意味着如果同一封电子邮件不止一次存在,他们将收到多封电子邮件。我想要做的是检查电子邮件是否存在于多行中(已经排序)并仅发送一封电子邮件(包含所有附件)。这有可能吗?

这是我的代码:

Dim objOutlook As Outlook.Application
Dim objMail As Outlook.MailItem

Dim rngTo As Range
Dim rngSubject As Range
Dim rngBody As Range
Dim rngAttach As Range

ActiveSheet.Range("A2").Select

Do Until IsEmpty(ActiveCell)

    Set objOutlook = CreateObject("Outlook.Application")
    Set objMail = objOutlook.CreateItemFromTemplate("C:\Desktop\EBILL\template.oft")
    With objMail
    .To = ActiveCell.Offset(0, 4).Value
    .Subject = "Invoice For: " & " " & Month & " - " & Year
    .Attachments.Add ActiveCell.Offset(0, 5).Value
    ActiveCell.Offset(1, 0).Select
    .Display 'Instead of .Display, you can use .Send to send the email or .Save to save a copy in the drafts folder
    End With

Loop


    Set objOutlook = Nothing
    Set objMail = Nothing
    Set rngTo = Nothing
    Set rngSubject = Nothing
    Set rngBody = Nothing
    Set rngAttach = Nothing

1 个答案:

答案 0 :(得分:0)

找到了有效的答案。希望这可以帮助有类似情况的人

With objMail
.To = ActiveCell.Offset(0, 4).Value
.Subject = "Invoice For: " & " " & Month & " - " & Year
.Attachments.Add ActiveCell.Offset(0, 5).Value
ActiveCell.Offset(1, 0).Select

Do Until ActiveCell.Offset(0, 4).Value <> .To
    .Attachments.Add ActiveCell.Offset(0, 5).Value
    ActiveCell.Offset(1, 0).Select
Loop
.Display 'Instead of .Display, you can use .Send to send the email or .Save to save a copy in the drafts folder
End With