如何从代码发送电子邮件提醒 [英] How to send email reminder from code

问题描述

  Sub SendReminderMail（）
 Dim OutlookApp As Object 
 Dim OutLookMailItem As Object 
 Dim iCounter As Integer 
 Dim MailDest As String 
 
设置OutlookApp = CreateObject（Outlook.application）
设置OutLookMailItem = OutlookApp.CreateItem（0）
 
使用OutLookMailItem 
 MailDest =
 
对于iCounter = 1到WorksheetFunction.CountA（列（34））
如果MailDest =和Cells（iCounter，34）.Offset（0，-1）=发送提醒然后
 MailDest = Cells（iCounter，34）.Value 
 ElseIf MailDest<> 和细胞（iCounter，34）.Offset（0，-1）=发送提醒然后
 MailDest = MailDest& ; &安培;单元格（iCounter，34）.Value 
 End If 
 Next iCounter 
 
 .BCC = MailDest 
 .Subject =ECR Notification
 .HTMLBody = 提醒：这是一个自动ECR电子邮件通知的测试，请完成您的任务ECR＃
。发送
结束
 
设置OutLookMailItem =没有
设置OutlookApp = Nothing 
 End Sub 
  

---

需要代码通过设置提醒文本向列AE中的值发送电子邮件

解决方案

GD mjac，

你仍然害怕你的信息？ >

您提交的代码收集所有地址，然后发送单个消息？我会期望，根据您的示例表/数据，您想要向每个收件人发送一个开放的每个ECR代码的电子邮件？

所以假设以下内容：

• 您想要为发送提醒为
  true
$

• AH列中的电子邮件地址会因为每一行而有所不同？

在代码中使用Outlook 。应用对象设置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 作为公开的，首先是其他的subs /函数等等。
（即在编码窗口的顶部）

 公共OutlookApp作为Outlook.Application 
  

您的sendReminderMail（）sub

  Sub SendReminderMail（）
 Dim iCounter As Integer 
 Dim MailDest As String 
 Dim ecr As Long 
 
错误GoTo doOutlookErr：
设置OutlookApp =新的Outlook.Application 
 
对于iCounter = 1 To WorksheetFunction.CountA （列（34））
 MailDest = Cells（iCounter，34）.Value 
 ecr = Cells（iCounter，34）.Offset（0，-3）.Value 
 
如果不是MailDest = vb NullString And Cells（iCounter，34）.Offset（0，-1）=发送提醒然后
 sendMail MailDest，ecr 
 MailDest = vbNullString 
如果
 
下一步iCounter 
 
'基本错误处理，以防止Outlook实例在出现错误时保持打开状态。 
 doOutlookErrExit：
如果不是OutlookApp是没有
 OutlookApp.Quit 
结束如果
退出子
 
 doOutlookErr：
 MsgBox Err.Description，vbOKOnly，Err.Source& ：& Err.Number 
简历doOutlookErrExit 
 
 End Sub 
  

添加sendMail功能：

 函数sendMail（sendAddress As String，ecr As Long）As Boolean 
 
'启动函数返回值
 sendMail = False 
错误GoTo doEmailErr：
 
'启动变量
 Dim OutLookMailItem作为Outlook.MailItem 
 Dim htmlBody As String 
 
'创建邮件项
设置OutLookMailItem = OutlookApp.CreateItem（olMailItem）
 
'创建邮件的连接体
 htmlBody =< html>< body>提醒：这是自动ECR电子邮件通知的测试。< br> &安培; _ 
请完成ECR＃& CStr（ecr）& < /体>< / HTML> 中
 
'Chuck'm一起发送
 With OutLookMailItem 
 
 .BCC = sendAddress 
 .Subject =ECR通知
 .HTMLBody = htmlBody 
。发送
 
结束
 
 sendMail = True 
 
 doEmailErrExit：
退出函数
 
 doEmailErr：
 MsgBox Err.Description，vbOKOnly，Err.Source& ：& Err.Number 
简历doEmailErrExit 
 
 
结束功能
  

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

---

Need code to email the values in columns AE with the "set reminder" text

解决方案

GD mjac,

You are still shy with your information...?

Your presented code collects all addresses and subsequently sends a single message ? I would expect, based on your example sheet/data that you would want to send an email to each recipient for each ECR code that is 'open' ?

So assuming the following:

• You want to send an email for every line where the "Send reminder" is true
• The email addresses in columns "AH" will differ for every line ?

In your code you use the Outlook.Application objects Set OutlookApp = CreateObject("Outlook.application"), be careful with opening application type objects and be sure to ensure they will be closed in the event the code finishes or when an error is triggered, otherwise you could potentially end up with a number of Outlook instances that are 'running' using valuable reqources. The below code has some basic error handling to ensure the OutlookApp object is closed if no longer required.

Setup your Workbook as follows:

In VB Editor under Tools|References find 'Microsoft Outlook xx.x Object Library', where xx.x represents the version of Outlook that you are working with. (see also: https://msdn.microsoft.com/en-us/library/office/ff865816.aspx) This will make for easier coding as you get intellisense suggestions for your objects.

Declare OutlookApp as public, above all other subs/functions etc. etc. (i.e. at the top of your 'coding' window)

Public OutlookApp As Outlook.Application

your sendReminderMail() sub

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

added sendMail Function:

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

这篇关于如何从代码发送电子邮件提醒的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！