如果存在旧的未读邮件，则发送电子邮件

Question

如果有超过15分钟的未读电子邮件，我正尝试给自己发送一封电子邮件。

的代码，当我手动从Outlook中运行，发送邮件，但我得到一个

运行时错误“-2147221238”（8004010a）

我不能让它从规则运行或与任务时间表独立可能由于上述错误。

Sub checkForUnreadMails() 

    Dim objFolder, objNamespace 
    'get running outlook application or open outlook 
    Set objOutlook = GetObject(, "Outlook.Application") 
    If objOutlook Is Nothing Then 
     Set objOutlook = CreateObject("Outlook.Application") 
    End If 

    Set objNamespace = objOutlook.GetNamespace("MAPI") 
    Set objMsg = Application.CreateItem(olMailItem) 

    strFilter = "[received] <= '" & Format(DateAdd("n", -15, Now()), "ddddd h:nn AMPM") & "'" 
    Debug.Print strFilter 
    Set inboxItems = objNamespace.GetDefaultFolder(olFolderInbox).Items.Restrict(strFilter) 
    strFilter = "[Unread] = True" 
    Set unreadItems = inboxItems.Restrict(strFilter) 

    For Each itm In unreadItems 
     With objMsg 
      .To = "email@email.com" 
      .Subject = "outlookrule There are unread emails over 15 minutes old in Vision ATM mailbox" 
      .Categories = "T" 
      .BodyFormat = olFormatPlain ' send plain text message 
      .Importance = olImportanceHigh 
      .Sensitivity = olConfidential 
      .Send 
     End With 
    Next 
End Sub 

Answer 1

错误代码是MAPI_E_OBJECT_DELETED。你的代码没有多大意义 - 你创建objMsg一次，但是尝试多次发送它（你不能）为每个未读项目。

为什么您要为每封未读电子邮件多次发送电子邮件？您实际上并未从该电子邮件中检索任何信息。无论是简单地检查是否有匹配的电子邮件（unreadItems.Count > 0）并发送一次电子邮件，或者在循环的每次迭代中创建一条新消息（Set objMsg = Application.CreateItem(olMailItem)），并包含一些特定的电子邮件详细信息。

Sub checkForUnreadMails() 

    Dim objFolder, objNamespace 
    'get running outlook application or open outlook 
    Set objOutlook = GetObject(, "Outlook.Application") 
    If objOutlook Is Nothing Then 
     Set objOutlook = CreateObject("Outlook.Application") 
    End If 

Set objNamespace = objOutlook.GetNamespace("MAPI") 

strFilter = "[received] <= '" & Format(DateAdd("n", -15, Now()), "ddddd h:nn AMPM") & "'" 
Debug.Print strFilter 
Set inboxItems = objNamespace.GetDefaultFolder(olFolderInbox).Items.Restrict(strFilter) 
strFilter = "[Unread] = True" 
Set unreadItems = inboxItems.Restrict(strFilter) 
if unreadItems.Count > 0 Then 
    Set objMsg = Application.CreateItem(olMailItem) 
    With objMsg 
       .To = "email@email.com" 
       .Subject = "outlookrule There are unread emails over 15 minutes old in Vision ATM mailbox" 
       .Categories = "T" 
       .BodyFormat = olFormatPlain ' send plain text message 
       .Importance = olImportanceHigh 
       .Sensitivity = olConfidential 
       .Send 
     End With 
    End If 
End Sub 

Answer 2

只要启动StartTimer一旦你打开Outlook中，
直到你关闭Outlook它会运行checkForUnreadMails每15分钟！

Option Explicit 

Public RunWhen As Double 
Public Const cRunIntervalSeconds = 900 ' 15 minutes 
Public Const cRunWhat = "checkForUnreadMails" ' the name of the procedure to run 

Sub StartTimer() 
    RunWhen = Now + TimeSerial(0, 0, cRunIntervalSeconds) 
    Application.OnTime EarliestTime:=RunWhen, Procedure:=cRunWhat, _ 
     Schedule:=True 
End Sub 



Sub checkForUnreadMails() 
    Dim objFolder, objNamespace 
    Dim areUnread As Boolean 
    areUnread = False 

    '''get running outlook application or open outlook 
    Set objOutlook = GetObject(, "Outlook.Application") 
    If objOutlook Is Nothing Then Set objOutlook = CreateObject("Outlook.Application") 
    Set objNamespace = objOutlook.GetNamespace("MAPI") 
    Set objMsg = Application.CreateItem(olMailItem) 

    strFilter = "[received] <= '" & Format(DateAdd("n", -15, Now()), "ddddd h:nn AMPM") & "'" 
    'Debug.Print strFilter 
    Set inboxItems = objNamespace.GetDefaultFolder(olFolderInbox).Items.Restrict(strFilter) 
    strFilter = "[Unread] = True" 
    Set unreadItems = inboxItems.Restrict(strFilter) 

    For Each itm In unreadItems 
     If itm.Subject <> vbNullString Then 
      areUnread = True 
      Exit For 
     Else 
     End If 
    Next itm 

    If areUnread Then 
     With objMsg 
      .to = "email@email.com" 
      .Subject = "outlookrule There are unread emails over 15 minutes old in Vision ATM mailbox" 
      .Categories = "T" 
      .BodyFormat = olFormatPlain 
      '''send plain text message 
      .Importance = olImportanceHigh 
      .Sensitivity = olConfidential 
      .Send 
     End With 'objMsg 
    End If 

    StartTimer 
End Sub 

使用此停止计时器，当你想保持Outlook中打开，而不是运行sricpt每15分钟

Sub StopTimer() 
    On Error Resume Next 
    Application.OnTime EarliestTime:=RunWhen, Procedure:=cRunWhat, _ 
     Schedule:=False 
End Sub