【发布时间】：2021-07-07 19:42:22
【问题描述】：
我正在尝试从 VBA 发送 2 封不同的电子邮件，当第二封电子邮件弹出时我卡住了，因为收件人没有按要求填写。
我不是很精通编码，但设法将以下代码放在一起；见以下代码：
Sub Export_Mail()
Dim strFile As String
Dim OutApp As outlook.Application
Dim objOutlookMsg As outlook.MailItem
Dim objOutlookRecip As Recipient
Dim Recipients As Recipients
Dim strFile2 As String
Dim OutApp2 As outlook.Application
Dim objOutlookMsg2 As outlook.MailItem
Dim objOutlookRecip2 As Recipient
Dim Recipients2 As Recipients
Dim sDate
sDate = Date
Set OutApp = CreateObject("Outlook.Application")
Set objOutlookMsg = OutApp.CreateItem(olMailItem)
strFile = "C:\filepath\filename.xlsx" 'Directories to save and get attachments from; including filename
strFile2 = "C:\filepath\filename2.xlsm"
strBody = "<BODY style=font-size:10pt> Hello Customer team,<br><br>Greetings greetings<br>Attached file extract." & vbCrLf & vbCrLf
strBody2 = "<BODY style=font-size:10pt> Hello Internal team,<br><br>Greetings greetings<br>Attached full file." & vbCrLf & vbCrLf
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs Filename:=strFile2 'Turn alerts off to overwrite both files always
Sheets("Sheet1").Select
Sheets("Sheet1").Copy
ActiveWorkbook.SaveAs Filename:=strFile
Application.DisplayAlerts = True
ActiveWorkbook.Close
Set Recipients = objOutlookMsg.Recipients
Set objOutlookRecip = Recipients.Add("cust1@example.com")
objOutlookRecip.Type = 1 ' Type 1 = To; Type 2 = CC
Set objOutlookRecip = Recipients.Add("cust2@example.com")
objOutlookRecip.Type = 1
Set objOutlookRecip = Recipients.Add("cust3@example.com")
objOutlookRecip.Type = 2
Set objOutlookRecip = Recipients.Add("cust4@example.com")
objOutlookRecip.Type = 2
With objOutlookMsg
'.SentOnBehalfOfName = "myemail@example.net"
.Subject = "Email Subject " & sDate
For Each objOutlookRecip In objOutlookMsg.Recipients 'Resolve each Recipient's name.
objOutlookRecip.Resolve
Next
.Attachments.Add strFile
.display
.HTMLBody = strBody & .HTMLBody
End With
'objOutlookMsg.send
'Set OutApp = Nothing
'Application.Wait (Now + TimeValue("00:00:10"))
Set OutApp2 = CreateObject("Outlook.Application")
Set objOutlookMsg2 = OutApp.CreateItem(olMailItem)
With objOutlookMsg2
.Subject = "Internal email sibject" & sDate
Set Recipients2 = objOutlookMsg.Recipients ' Type 1 = To; Type 2 = CC
Set objOutlookRecip2 = Recipients2.Add("internal1@example.net")
objOutlookRecip2.Type = 1
Set objOutlookRecip = Recipients2.Add("internal2@example.net")
objOutlookRecip2.Type = 1
Set objOutlookRecip = Recipients2.Add("internal3@example.net")
objOutlookRecip2.Type = 2
For Each objOutlookRecip In objOutlookMsg.Recipients 'Resolve each Recipient's name.
objOutlookRecip.Resolve
Next
.Attachments.Add strFile2
.display
.HTMLBody = strBody2 & .HTMLBody
End With
End Sub
我为第二封电子邮件设置的收件人正在第一封电子邮件中填写。 第二封电子邮件弹出没有收件人。 有关如何解决此问题的任何指示都会有很大帮助。
【问题讨论】：
-
Set Recipients2 = objOutlookMsg.Recipients应该是Set Recipients2 = objOutlookMsg2.Recipients??同样For Each objOutlookRecip In objOutlookMsg2.Recipients -
太棒了，非常感谢蒂姆，我错过了很多对第二组变量的引用
标签： excel vba email automation outlook