如果存在舊的未讀郵件，則發送電子郵件

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