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

打开Outlook后，只需启动StartTimer即可并且每15分钟运行一次checkForUnreadMails，直到你关闭Outlook！

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保持打开而不是每15分钟运行一次sricpt时，使用它来停止计时器

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

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

2 个答案: