2015-06-16 44 views
0

我已經制作了一個小宏來統計我的收件箱中有多少封未讀電子郵件。然後我發送一些數據到一個串口並控制一個紅綠燈。Outlook和宏。無法更改文件夾或搜索

我有一個問題,我的宏,它有一個while循環,並不斷檢查收件箱。循環中有一個DoEvents,它的運行順利。除了宏在運行時以外,

- 如果我點擊一個未讀電子郵件來閱讀它,然後點擊另一封電子郵件,以前的電子郵件現在應該被標記爲已讀。這不會發生,我必須手動將其標記爲已讀或雙擊以打開電子郵件。

- 我不能使用搜索功能,它只會等到我停止宏運行。

- 我無法更改我正在查看的文件夾,直到我停止宏。

如何定期統計我有多少個未讀電子郵件,而無需在我的宏中使用循環?

我看過創建一個新的線程(不可能在Outlook中),並使用定時器(經常崩潰,計時器似乎不可預知)。

'Checks for unread email and sets Trafic Light color 
Sub CheckMail() 
runner = 1 
MailTemp = -1 
While (runner) 
    Const olFolderInbox = 6 
    Set objOutlook = CreateObject("Outlook.Application") 
    Set objNamespace = objOutlook.GetNamespace("MAPI") 
    objNamespace.Logon "Default Outlook Profile", , False, True 
    Set objFolder = objNamespace.GetDefaultFolder(olFolderInbox) 

    If MailTemp <> objFolder.UnReadItemCount Then 
     MailTemp = objFolder.UnReadItemCount 

     If objFolder.UnReadItemCount = 0 Then 
      Shell "C:\Users\cave\Desktop\Miles Cave\TrafficLight\USB\Mail_0.bat", vbMinimizedNoFocus 
     End If 

     If objFolder.UnReadItemCount = 1 Then 
      Shell "C:\Users\cave\Desktop\Miles Cave\TrafficLight\USB\Mail_1.bat", vbMinimizedNoFocus 
     End If 

     If objFolder.UnReadItemCount > 1 Then 
      Shell "C:\Users\cave\Desktop\Miles Cave\TrafficLight\USB\Mail_2.bat", vbMinimizedNoFocus 
     End If 
    End If 
    DoEvents 
Wend 
End Sub 

'Sets Trafic Light to off and stops CheckMail 
Sub StopMail() 
    Shell "C:\Users\cave\Desktop\Miles Cave\TrafficLight\USB\Lights off.bat", vbMinimizedNoFocus 
    runner = 0 
End Sub 

這是我的代碼。在CheckMail()中有5行代碼來獲取未讀電子郵件的數量,然後是如果檢查未讀電子郵件的數量是否已更改,以及根據電子郵件數量檢查3個選項。

StopMail()簡單地停止CheckMail()中的While循環。

回答

0

您需要使用Items類的Find/FindNextRestrict方法來查找所有未讀項目。例如,Restrict方法將一個篩選器應用於Items集合,返回一個新集合,其中包含與篩選器匹配的原始項目中的所有項目。那麼你可以簡單地使用Items類的Count屬性。

還請注意名稱空間類的AdvancedSearch方法。它允許在另一個線程上運行搜索並輕鬆獲取多個文件夾中未讀項目的數量。

使用以下搜索條件= "[UnRead] = true"

您可能會發現下面的文章有幫助:

+0

嗨尤金,我不能使用他在Outlook中的搜索工具中建立。我不想用代碼搜索。我在While循環中遇到了問題,不能讓我正常使用Outlook功能。感謝輸入 –

+0

VBA代碼在主線程上運行。在代碼停止/結束之前,您無法在Outlook中執行任何操作。即使在Outlook加載項中也不建議,Outlook 2013可能會在這種情況下引發異常。唯一可能的方法是使用低級API - 擴展MAPI在後臺運行代碼。請注意,AdvancedSearch方法在後臺搜索項目,因此您可以先嚐試。 –

0

你可能會引發不帶定時器或至少在兩個方面while循環。

1 - 當ItemAdd

2接收到的郵件 - 當一個郵件的未讀狀態更改爲與ItemChange事件看,像這樣

在ThisOutlookSession

Private WithEvents checkMailItems As Items 

Private Sub Application_Startup() 
    Dim ns As Namespace 
    Set ns = Application.GetNamespace("MAPI") 
    Set checkMailItems = ns.GetDefaultFolder(olFolderInbox).Items 
End Sub 

Private Sub checkMailItems_ItemChange(ByVal Item As Object) 
    If TypeOf Item Is mailItem And Item.UnRead = False Then CheckMail 
End Sub 

在常規模塊中

Sub CheckMail() 

    Dim objNameSpace As Namespace 
    Dim objFolder As Folder 
    Dim uIC As Long 

    Set objNameSpace = Application.GetNamespace("MAPI") 
    Set objFolder = objNameSpace.GetDefaultFolder(olFolderInbox) 

    uIC = objFolder.UnReadItemCount 

    Select Case uIC 

    Case 0 
     Debug.Print "Inside CheckMail - uIC = " & uIC 
     'Shell "C:\Users\cave\Desktop\Miles Cave\TrafficLight\USB\Mail_0.bat", vbMinimizedNoFocus 

    Case 1 
     Debug.Print "Inside CheckMail - uIC = " & uIC 
     'Shell "C:\Users\cave\Desktop\Miles Cave\TrafficLight\USB\Mail_1.bat", vbMinimizedNoFocus 

    Case Is > 1 
     Debug.Print "Inside CheckMail - uIC = " & uIC 
     'Shell "C:\Users\cave\Desktop\Miles Cave\TrafficLight\USB\Mail_2.bat", vbMinimizedNoFocus 

    End Select 

ExitRoutine: 
    Set objNameSpace = Nothing 
    Set objFolder = Nothing 

    Debug.Print "Procedure CheckMail is done." 

End Sub