使用VBA发送基于传入Outlook电子邮件的警报电子邮件

时间:2013-08-11 20:06:11

标签: vba outlook inbox

如果被告知如何,我可以附上我在这个问题中谈到的电子邮件。

我需要监控两个特定电子邮件的Outlook收件箱。每天晚上7点到达。另一个到达时间是晚上7点20分(任何一方都要花几分钟)。

第一个电子邮件主题:“Automatic1 08092013”​​。 Automatic1一词始终相同,数字代表日期。

第二个电子邮件主题:“Automatic2 - 2013年8月9日”。 Automatic2始终相同,但日期更改。

Automatic1的电子邮件正文包含一个字符串,其值代表货币。

7pm EmailBody示例:CustomerCount:11 VisitorNumber:121金额:811070

我需要CustomerCount,VisitorNumber和Amount:811070与第二封电子邮件中的值相比较。金额“811070”代表货币价值等于$ 8,110.70。

7:20电子邮件到达后,如果值不匹配,请发送警告电子邮件给我。

这是棘手的部分。下午7:20的电子邮件的值包含在多个表中。

7:20 pm示例EmailBody:

(这是表#1它包含2行和2列)

Process1总计(这是显示在第一个表格上方的电子邮件正文中的字符串文本)

...共1个记录Amount1

11 .......... 8110.70

(这是表#2它包含3行和2列)

Process2总计(这是显示在第二个表格上方的电子邮件正文中的字符串文本)

Count2 ..Amount2

121 ........ 811070

(这是表#3,它包含了一堆我不关心的东西)

击穿

ID号Amt ID2

296 15 737.33 0000113821

079 1 737.33 000938

34 1 737.33 0007000

746 10 737.33 0056200

741 8 737.33 0009733

089 6 737.33 0034664

636 1 737.33 007500

07 71 737.33 0000976

296 14 737.33 0023231

34 51 737.33 0000100

788 23 737.33 7100

Scenerios:

如果7:20电子邮件到达并且晚上7点不存在电子邮件(从同一天开始),请发送带有“警告文本”的电子邮件警报。

如果7:20电子邮件到达并且存在7Pm电子邮件(重要:从同一天开始),请比较

CustomerCount:11

下午7:20发送电子邮件表1第1列第2行中包含的Count1值

Count1 Amount1 11 8110.70

如果他们不匹配发送电子邮件与“CustomerCount不相等”

另外,比较7pm VisitorNumber:121

使用表2第2列第2行中包含的Count2值

Count2 Amount2 121 811070

如果他们不匹配发送电子邮件与“VisitorNumber不相等”

另外,比较7pm金额:811070

使用Table2 Amount2(见上文)第2列第2行中包含的值

如果匹配不匹配,请发送“金额不匹配”的电子邮件

每封电子邮件都应包含确定问题所涉及的实际数学。每封电子邮件都应包含所有数字。当谈到货币时,电子邮件正文中包含的两者之间应该有差异。如果值返回正数或负数,则无关紧要。 我不必为每个问题都单独发送电子邮件。只要它包含所有比较和货币差异,只需要一封电子邮件即可。如果7:20的电子邮件没有收到(没关系)和/或数字全部匹配且没有差异,则根本不会发送任何电子邮件。

示例:

主题:提醒

电子邮件正文:“夜间总计不匹配”

您的客户数= 11

原始收件人客户数= 12

已知问题:

下午7:20电子邮件中的单元格由于某种原因包含空格。

晚上7点的电子邮件是一个很长的字符串。

我对它应该如何运作的看法。

需要针对7:20电子邮件的主题行监控收件箱。

当7:20电子邮件进入我的收件箱搜索7pm电子邮件时,按主题搜索。

如果存在7pm电子邮件,则从每封电子邮件中获取值,比较并确定是否需要发送警报电子邮件。(简化过程)

我宁愿不涉及excel但要了解是否需要。

1 个答案:

答案 0 :(得分:0)

我认为你要求的是Outlook VBA代码。这听起来像是可能的事情,因为我自己写了Outlook VBA对用户进行基本的Active Directory操作(解锁,更改/重置密码) - 我用自己的用户名和指令发送电子邮件给我自己,然后几秒钟后,结果将通过电子邮件发送给我。

请注意,即使已完成的VBA代码,您也需要设置Outlook规则以运行VBA代码,并且必须打开Outlook会话,因为无法在服务器中完成。这也意味着你需要一台运行Outlook 24/7的计算机才能实现这一目标。

如果不能测试实际的.msg文件,将无法生成完整的VBA代码。

但有些东西让你开始......(尚未完全测试)

Private Const sLookUp = "Automatic1 "

Public Sub Rules_Automatic2(oMailAuto2 As MailItem)
    Dim sDate As Date, oMailAuto1 As MailItem, sSubject As String, sBody As String

    ' Exit if "Automatic2" is NOT the first word in subject
    If InStr(1, Left(oMailAuto2.Subject, 10), "Automatic2", vbTextCompare) = 0 Then Exit Sub
    ' Get the date value in subject and get the corresponding Automatic1 mail item
    sDate = DateValue(Split(oMailAuto2.Subject, "-"))
    oMailAuto1 = GetAuto1Email(sLookUp & Format(sDate, "mmddyyyy"))

    If oMailAuto1 Is Nothing Then
        ' corresponding Automatic1 email not found
        sSubject = "Warning Text"
        sBody = "Corresponding email for """ & oMailAuto2.Subject & """ is not found!"
        SendEmail sSubject, sBody
    Else
        CompareAutomatics oMailAuto2, oMailAuto1
    End If
End Sub

Private Function GetAuto1Email(sTxt As String) As MailItem
    Dim oOlkFDR As Outlook.Folder, oMail As MailItem, oMailAuto1 As MailItem

    Set oMailAuto1 = Nothing
    Set oOlkFDR = Application.Session.GetDefaultFolder(olFolderInbox)
    For Each oMail In oOlkFDR.Items
        If InStr(1, oMail.Subject, sTxt, vbTextCompare) Then
            Set oMailAuto1 = oMail
            Exit For
        End If
    Next
    GetAuto1Email = oMailAuto1
End Function

Private Sub CompareAutomatics(oMailAuto2 As MailItem, oMailAuto1 As MailItem)
    Dim sBody2 As String, sBody1 As String, sSubject As String, sReply As String

    sBody2 = oMailAuto2.Body
    sBody1 = oMailAuto1.Body
    sSubject = ""
    sReply = ""
    ' Do Comparisons and setup email body and subject
    ' ...
    ' ...
    SendEmail sSubject, sReply
End Sub

Private Sub SendEmail(sSubject As String, sBody As String)
    Dim oMail As MailItem

    Set oMail = Application.CreateItem(olMailItem)
    With oMail
        .Subject = sSubject
        .BodyFormat = olFormatPlain
        .Body = sBody
        .Send
    End With
    Set oMail = Nothing
End Sub

希望您了解Outlook VBA中的工作原理......