首页 文章

如何检查选择是否在Outlook搜索文件夹中

提问于
浏览
0

我使用此代码来获取Outlook中的选择:

Dim conversations As Outlook.Selection
Set conversations = Application.ActiveExplorer.Selection.GetSelection(Outlook.OlSelectionContents.olConversationHeaders)

我必须使用不同的方法来遍历对话,电子邮件等,并根据选择的位置进行错误处理 . 例如,Outlook搜索文件夹的过程与标准文件夹的不同 .

我想知道选择是否在Outlook搜索文件夹中 .

可以这样做吗?

1 回答

  • 0

    这将指示项目(不一定是选择)是否在搜索文件夹中 .

    Option Explicit
    
    Private Sub SearchFolder_Items()
    
        Dim acctStr As String
        Dim mailboxStr As String
    
        Dim objItm As Object
        Dim objFldrItm As Object
    
        Dim colStores As stores
    
        Dim oSearchFolders As Folders
        Dim oFolder As Folder
    
        Dim i As Long
    
        Dim colItems As Items
        Dim colItemsRes As Items
    
        Dim srchFldrItm As Object
    
        Dim subjSingleQuote As String
    
        Dim subjNoReFW As String
        Dim strFilter As String
    
        Dim foundFlag As Boolean
    
        mailboxStr = const_emAddress    '   <-- your "email address" in quotes
        acctStr = Session.Accounts(mailboxStr)
    
        Set objItm = ActiveExplorer.Selection(1)
    
        Set colStores = Session.stores
    
        For i = 1 To colStores.count
    
            If colStores(i) = acctStr Then
    
                Set oSearchFolders = colStores(i).GetSearchFolders
    
                If InStr(objItm.subject, Chr(39)) Then
    
                    Debug.Print " objItm.subject.....: " & objItm.subject & " contains a single quote."
                    Debug.Print " The restrict filter does not accommodate the single quote Chr(39)"
                    Debug.Print "  this way will be slow."
    
                    For Each oFolder In oSearchFolders
    
                        Debug.Print " SearchFolder.......: " & oFolder.name
    
                        For Each objFldrItm In oFolder.Items
    
                            DoEvents
    
                            If objItm.entryID = objFldrItm.entryID Then
    
                                Debug.Print
                                Debug.Print objItm.subject & " is in search folder: " & oFolder.name
                                Debug.Print
    
                                foundFlag = True
    
                            End If
    
                        Next
    
                    Next
    
                Else
    
                    ' Interesting wrinkle just discovered
                    ' Must remove "RE: " and "FW: " from subject in search folder
                    If Left(objItm.subject, 4) = "RE: " Then
                        subjNoReFW = Right(objItm.subject, Len(objItm.subject) - 4)
    
                    ElseIf Left(objItm.subject, 4) = "FW: " Then
                        subjNoReFW = Right(objItm.subject, Len(objItm.subject) - 4)
    
                    Else
                        subjNoReFW = objItm.subject
                    End If
    
                    strFilter = "[Subject] = '" & subjNoReFW & "'"
    
                    For Each oFolder In oSearchFolders
    
                        DoEvents
    
                        Set colItems = oFolder.Items
                        Set colItemsRes = colItems.Restrict(strFilter)
    
                        If colItemsRes.count > 0 Then
    
                            For Each srchFldrItm In colItemsRes
    
                                If objItm.entryID = srchFldrItm.entryID Then
    
                                    Debug.Print
                                    Debug.Print objItm.subject & vbCr & " in search folder: " & oFolder.name
    
                                    foundFlag = True
    
                                End If
    
                            Next
    
                        End If
    
                    Next
    
               End If
    
            End If
    
        Next
    
        If foundFlag = False Then
    
            Debug.Print vbCr & objItm.subject & vbCr & " not found in a search folder."
    
        End If
    
    ExitRoutine:
    
        Debug.Print
        Debug.Print objItm.subject & vbCr & " is in folder: " & objItm.Parent
    
        Debug.Print
        Debug.Print "Done"
    
    End Sub
    

相关问题