Vba Outlook和宏。无法更改文件夹或搜索

我制作了一个小宏来计算收件箱中有多少未读的电子邮件。然后我将一些数据发送到串行端口并控制交通灯

我的宏有问题，它有一个while循环，并且经常检查收件箱。在循环中有一个DoEvents，所有的工作都很顺利。除了宏运行时

-如果我点击一封未读的邮件阅读它，然后点击另一封邮件，上一封邮件现在应该标记为已读。这不会发生，我必须手动将其标记为已读或双击以打开电子邮件

-我无法使用搜索功能，它将一直等到我停止运行宏

-在停止宏之前，我无法更改正在查看的文件夹

如果不在宏中使用循环，我如何定期统计我有多少未读电子邮件

我考虑过创建一个新线程（在outlook中不可能），以及使用计时器（经常崩溃，计时器看起来不可预测）

”检查未读电子邮件并设置交通灯颜色
子支票邮件（）
流道=1
MailTemp=-1
While（跑步者）
常数olFolderInbox=6
设置objOutlook=CreateObject（“Outlook.Application”）
设置objNamespace=objOutlook.GetNamespace（“MAPI”）
objNamespace.Logon“默认Outlook配置文件”，False，True
设置objFolder=objNamespace.GetDefaultFolder（olFolderInbox）
如果MailTemp objFolder.unreademcount，则
MailTemp=objFolder.unreademcount
如果objFolder.unreademcount=0，则
Shell“C:\Users\cave\Desktop\Miles cave\TrafficLight\USB\Mail_0.bat”，vbMinimizedNoFocus
如果结束
如果objFolder.unreademcount=1，则
Shell“C:\Users\cave\Desktop\Miles cave\TrafficLight\USB\Mail_1.bat”，vbMinimizedNoFocus
如果结束
如果objFolder.unreademcount>1，则
Shell“C:\Users\cave\Desktop\Miles cave\TrafficLight\USB\Mail_2.bat”，vbMinimizedNoFocus
如果结束
如果结束
多芬特
温德
端接头
'将交通灯设置为关闭并停止支票邮寄
子StopMail（）
Shell“C:\Users\cave\Desktop\Miles cave\TrafficLight\USB\Lights off.bat”，vbMinimizedNoFocus
跑步者=0
端接头

这是我的密码。在CheckMail（）中，有5行代码用于获取未读电子邮件的数量，然后是一个if，用于检查未读电子邮件的数量是否已更改，以及根据电子邮件的数量确定的3个操作选项

StopMail（）只是停止CheckMail（）中的While循环。

您需要使用Items类的/or方法来查找所有未读的项目。例如，Restrict方法将筛选器应用于Items集合，返回一个新集合，其中包含原始集合中与筛选器匹配的所有项。因此，您可以简单地使用Items类的属性

还要注意Namespace类的方法。它允许在另一个线程上运行搜索，并轻松获取多个文件夹中未读项目的数量

使用以下搜索条件=

“[未读]=true”

您可能会发现以下文章很有帮助：

---

您可以在不使用计时器或while循环的情况下通过至少两种方式触发
1-收到带有ItemAdd的邮件时
或
2-当邮件的未读状态随ItemChange事件更改为read时，如下所示
在本次展望会上

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

---

嗨，尤金，我不能在Outlook中使用他内置的搜索工具。我没有试图用代码搜索。我在While循环中遇到问题，无法正常使用outlook函数。感谢您的输入VBA代码在主线程上运行。在代码停止/结束之前，您无法在Outlook中执行任何操作。即使在Outlook加载项中，也不建议使用Outlook 2013，在这种情况下，Outlook 2013可能会抛出异常。唯一可能的方法是使用低级API扩展MAPI在后台运行代码。注意，AdvancedSearch方法在后台搜索项目，因此您可以先试用。

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