Sub SendReminderMail()
Dim OutlookApp As Object
Dim OutLookMailItem As Object
Dim iCounter As Integer
Dim MailDest As String
Set OutlookApp = CreateObject("Outlook.application")
Set OutLookMailItem = OutlookApp.CreateItem(0)
With OutLookMailItem
MailDest = ""
For iCounter = 1 To WorksheetFunction.CountA(Columns(34))
If MailDest = "" And Cells(iCounter, 34).Offset(0, -1) = "Send Reminder" Then
MailDest = Cells(iCounter, 34).Value
ElseIf MailDest <> "" And Cells(iCounter, 34).Offset(0, -1) = "Send Reminder" Then
MailDest = MailDest & ";" & Cells(iCounter, 34).Value
End If
Next iCounter
.BCC = MailDest
.Subject = "ECR Notification"
.HTMLBody = "Reminder: This is a test for an automatic ECR email notification. Please complete your tasks for ECR#"
.Send
End With
Set OutLookMailItem = Nothing
Set OutlookApp = Nothing
End Sub
需要使用“设置提醒”文字
通过电子邮件发送AE列中的值的代码答案 0 :(得分:1)
GD mjac,
你仍然对你的信息感到害羞......?
您提供的代码会收集所有地址,然后发送一条消息吗?我希望,根据您的示例表/数据,您希望为每个“开放”的ECR代码向每个收件人发送电子邮件?
假设如下:
在您的代码中使用Outlook.Application对象Set OutlookApp = CreateObject("Outlook.application")
,请小心打开应用程序类型对象,并确保在代码完成或触发错误时关闭它们,否则您最终可能会有一些使用有价值的资源“运行”的Outlook实例。下面的代码有一些基本的错误处理,以确保OutlookApp
对象在不再需要时关闭。
按如下方式设置工作簿:
在“工具”|“参考”下的“VB编辑器”中,找到“Microsoft Outlook xx.x对象库”,其中xx.x表示您正在使用的Outlook版本。 (另请参阅:https://msdn.microsoft.com/en-us/library/office/ff865816.aspx)当您获得对象的智能感知建议时,这将使编码更容易。
将OutlookApp
声明为公开,高于所有其他潜艇/功能等。
(即在“编码”窗口的顶部)
Public OutlookApp As Outlook.Application
您的sendReminderMail()子
Sub SendReminderMail()
Dim iCounter As Integer
Dim MailDest As String
Dim ecr As Long
On Error GoTo doOutlookErr:
Set OutlookApp = New Outlook.Application
For iCounter = 1 To WorksheetFunction.CountA(Columns(34))
MailDest = Cells(iCounter, 34).Value
ecr = Cells(iCounter, 34).Offset(0, -3).Value
If Not MailDest = vbNullString And Cells(iCounter, 34).Offset(0, -1) = "Send Reminder" Then
sendMail MailDest, ecr
MailDest = vbNullString
End If
Next iCounter
'basic errorhandling to prevent Outlook instances to remain open in case of an error.
doOutlookErrExit:
If Not OutlookApp Is Nothing Then
OutlookApp.Quit
End If
Exit Sub
doOutlookErr:
MsgBox Err.Description, vbOKOnly, Err.Source & ":" & Err.Number
Resume doOutlookErrExit
End Sub
添加了sendMail功能:
Function sendMail(sendAddress As String, ecr As Long) As Boolean
'Initiate function return value
sendMail = False
On Error GoTo doEmailErr:
'Initiate variables
Dim OutLookMailItem As Outlook.MailItem
Dim htmlBody As String
'Create the mail item
Set OutLookMailItem = OutlookApp.CreateItem(olMailItem)
'Create the concatenated body of the mail
htmlBody = "<html><body>Reminder: This is a test for an automatic ECR email notification.<br>" & _
"Please complete your tasks for ECR#" & CStr(ecr) & "</body></html>"
'Chuck 'm together and send
With OutLookMailItem
.BCC = sendAddress
.Subject = "ECR Notification"
.HTMLBody = htmlBody
.Send
End With
sendMail = True
doEmailErrExit:
Exit Function
doEmailErr:
MsgBox Err.Description, vbOKOnly, Err.Source & ":" & Err.Number
Resume doEmailErrExit
End Function