如何将一封电子邮件发送到 Excel 工作簿中的电子邮件列表? excel VBA

问题描述

这是我当前的代码,但我希望能够发送到我的工作簿中的电子邮件列表。我将如何使用代码邮件部分来解决这个问题。我想将 R 列命名为邮件列表,它将一起发送到插入该列/列表中的任何电子邮件。想想当我尝试一些东西时,我不知何故缺少一个组件。

Sub SendReminderMail1()

  Dim wb1 As Workbook
  Dim wb2 As Workbook
  Dim TempFilePath As String
  Dim TempFileName As String
  Dim FileExtStr As String
  Dim OutApp As Object
  Dim OutMail As Object



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

Set wb1 = ActiveWorkbook


TempFilePath = Environ$("temp") & "\"
TempFileName = "copy of " & wb1.Name & " " & Format(Now,"dd-mmm-yy h-mm-ss")
FileExtStr = "." & LCase(Right(wb1.Name,Len(wb1.Name) - InStrRev(wb1.Name,".",1)))

wb1.SavecopyAs TempFilePath & TempFileName & FileExtStr
Set wb2 = Workbooks.Open(TempFilePath & TempFileName & FileExtStr)

wb2.Worksheets(1).Range("A1").Value = "copy created on " & Format(Date,"dd-mmm-yyyy")

wb2.Save


Set OutApp = CreateObject("outlook.application")
Set OutMail = OutApp.CreateItem(0)


On Error Resume Next
With OutMail
    .To = " "
    .CC = ""
    .BCC = ""
    .Subject = "Rotations needed for ."
    .Body = "hey there,equipment needs to be rotated."
    .Attachments.Add wb2.FullName

    .display   'or use .Send to send with display proof reading

End With
On Error GoTo 0
wb2.Close savechanges:=False

Kill TempFilePath & TempFileName & FileExtStr

Set OutMail = nothing
Set OutApp = nothing

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


MsgBox "Your Automated Email for BP Rotations was successfully ran at " & TimeValue(Now),vbinformation

End Sub

解决方法

在您的代码中,您将收件人字段设置为空字符串:

With OutMail
    .To = " "
    .CC = ""
    .BCC = ""

相反,您需要从 R 列读取值并为电子邮件添加收件人。要添加收件人,我建议使用 Recipients 集合,该集合可以使用 MailItem 类的相应属性进行检索。

Dim recipients As Outlook.Recipients = Nothing

Set recipients = mail.Recipients

' now we add new recipietns to the e-mail
        recipientTo = recipients.Add("Eugene")
        recipientTo.Type = Outlook.OlMailRecipientType.olTo
        recipientCC = recipients.Add("Dmitry")
        recipientCC.Type = Outlook.OlMailRecipientType.olCC
        recipientBCC = recipients.Add("eugene.astafiev@somedomain.com")
        recipientBCC.Type = Outlook.OlMailRecipientType.olBCC
        recipients.ResolveAll()

How To: Fill TO,CC and BCC fields in Outlook programmatically 文章中阅读更多相关信息。

,

邮件合并不是你的一杯茶吧...

也许你需要的是一个 Do while 循环,它引用人员表中的一个单元格,然后向下移动每一步直到电子邮件是空白的,只是通过一排又一排的电子邮件驱动着甜蜜的 CPU 使用率

就像用户在 Excel 中而不是在字处理器中编程邮件合并一样......就像邮件合并......在 Word 中,但不是在 Word 中,在 Excel 中在 VBA 中......

enter image description here