You need to enable JavaScript to run this app.
优惠活动
大模型
产品
解决方案
定价
更多

Outlook启动后客户端规则执行完毕时运行VBA脚本,AdvancedSearch失效

问题:Outlook启动后规则执行完毕仍无法捕获被规则移动的邮件

我需要一个在Outlook应用启动后、客户端规则处理完毕后运行的VBA脚本。我尝试在脚本运行前添加执行所有Outlook规则的代码,但问题并未解决——脚本仅能处理收件箱中的新邮件,被规则处理过的邮件无法被AdvancedSearch方法捕获,即使提前执行了规则代码也无效。

以下是相关VBA代码:

Option Explicit
Public blnSearchComp As Boolean

Private Sub Application_AdvancedSearchComplete(ByVal SearchObject As Search)
    Debug.Print "The AdvancedSearchComplete Event fired"
    If SearchObject.Tag = "Process_New_Items" Then
        'm_SearchComplete = True`   ' Use Option Explicit.
        blnSearchComp = True
   End If
  
End Sub

Private Sub Application_Startup()
        
    Dim dmi As MailItem
    Dim timeFol As Folder
    
    Dim timeFilter As String
    Dim lastclose As String
    Dim utcdate As Date
    Dim strFilter As String
    
    Dim i As Object
    
    Dim strScope As String
    Dim SearchObject As Search
    
'----------------------------------------------------------------------
    Dim olRules As Outlook.Rules
    Dim myRule As Outlook.Rule
    
    Set olRules = Application.Session.DefaultStore.GetRules()
       
       For Each myRule In olRules
        ' Rules we want to run
            myRule.Execute
        Next

'----------------------------------------------------------------------
        
    Set dmi = CreateItem(olMailItem)
    Set timeFol = Session.GetDefaultFolder(olFolderNotes)

    timeFilter = "[Subject] = 'App Close Time'"
    
    For Each i In timeFol.Items.Restrict(timeFilter)
        lastclose = i.CreationTime
    Next i
    Debug.Print lastclose
    
    utcdate = dmi.PropertyAccessor.LocalTimeToUTC(lastclose)
    
    'strFilter = "@SQL=""urn:schemas:httpmail:datereceived"" >= '&" & Format(utcdate, "dd mmm yyyy hh:mm") & "'"
    strFilter = "urn:schemas:httpmail:datereceived >= " & "'" & utcdate & "'"
    Debug.Print strFilter
    
    'strScope = "'" & Session.Folders(1).Folders("Inbox") & "'"
    Debug.Print strScope
    
    'strScope = "'" & Session.GetDefaultFolder(olFolderInbox) & "'"
    Debug.Print strScope
    
    strScope = "'Inbox'"
    Debug.Print strScope
    
    'strScope = "'" & Application.Session.GetDefaultFolder(olFolderInbox).FolderPath & "'"
    
    'Sleep (20)
    
    Set SearchObject = AdvancedSearch(Scope:=strScope, Filter:=strFilter, SearchSubFolders:=True, Tag:="Process_New_Items")
    
    blnSearchComp = False
    ' Otherwise remains True.
    ' Search would work once until Outlook restarted.
    
    While blnSearchComp = False
        DoEvents
        ' Code should be in a class module such as ThisOutlookSession
        Debug.Print "Wait a few seconds. Ctrl + Break if needed."
    Wend
    
    Debug.Print "SearchObject.results.count: " & SearchObject.Results.Count
    
    For Each i In SearchObject.Results
        If TypeName(i) = "MailItem" Then
            Process_MailItem i
            Debug.Print i.ReceivedTime, i.Subject
        Else: End If
    Next i
    
End Sub

内容的提问来源于stack exchange,提问作者Adam

相关产品推荐
方舟 Agent Plan

超全模态模型 × Harness 升级,最新支持 Deepseek-V4.1-Flash、GLM-5.3 系列、Doubao-Seedream-5.0-pro、Kimi-K3 (部分), 限时 9.9 元起

最近更新时间:2026.08.23 03:54:31