删除两个文件夹上的标志状态

Question

使用以下代码，我在Outlook启动时将标志状态“完成”设置为一个已定义的文件夹（ID）。是否可以使用另一个ID和分隔的过滤器来定义第二个文件夹，例如“ <= 1”并带有Flagstatus“ olNoFlag”？

我试图复制整个代码，重命名函数名称并设置另一个Foldername，但是没有成功。

Private Sub Application_Startup()
    Dim Item As Object
    Flagge_setzen Item
End Sub

Private Function Flagge_setzen(ByVal Item As Object)
    Dim olNs As Outlook.NameSpace
    Set olNs = Application.GetNamespace("MAPI")

    Dim olShareName As Outlook.Recipient
    Set olShareName = olNs.CreateRecipient("[email protected]")

    Dim olShareInbox As Outlook.Folder
    Set olShareInbox = olNs.GetSharedDefaultFolder(olShareName, olFolderInbox)

    Dim Completed_Fldrs As Outlook.MAPIFolder
    Set Completed_Fldrs = olNs.GetFolderFromID("0000000008F2D77ECE07A24EB6C27E0843C4B8880100CE3F23E508AB4F4A9A91BD99E6604421000000004C380000")

    Dim Filter As String
        Filter = "@SQL=" & Chr(34) & _
                 "http://schemas.microsoft.com/mapi/proptag/0x10900003" & _
                           Chr(34) & ">1"

    Dim Items As Outlook.Items
    Set Items = Completed_Fldrs.Items.Restrict(Filter)

    Dim Mail As MailItem

    Dim i As Long
    For i = Items.Count To 1 Step -1
        DoEvents
        If TypeOf Items(i) Is Outlook.MailItem Then
            Set Mail = Items(i)
            Debug.Print Mail.Subject
            Mail.FlagStatus = olFlagComplete
            Mail.Save
        End If
    Next

End Function


Sub GetFoldersEntryID()
    Dim olfolder As Outlook.MAPIFolder
    Dim olapp As Outlook.Application
    Set olapp = CreateObject("Outlook.Application")
    Set olfolder = olapp.GetNamespace("MAPI").PickFolder
    Debug.Print olfolder.EntryID
End Sub

Answer 1

是的，有可能。代码中有一些可以改进的地方（为什么使用不返回任何值的函数，并使用一个不使用的对象？并且硬编码的ID并不是最好的方法，但是我想它们可以工作）。 >

设置完第一个文件夹（从技术上讲，第一个文件夹中的项目之后，您可以为另一个过滤器+文件夹重复该过程，因此，类似：

Private Function Flagge_setzen(ByVal Item As Object)
    Dim olNs As Outlook.NameSpace
    Set olNs = Application.GetNamespace("MAPI")

    Dim olShareName As Outlook.Recipient
    Set olShareName = olNs.CreateRecipient("[email protected]")

    Dim olShareInbox As Outlook.Folder
    Set olShareInbox = olNs.GetSharedDefaultFolder(olShareName, olFolderInbox)

    Dim Completed_Fldrs As Outlook.MAPIFolder
    Set Completed_Fldrs = olNs.GetFolderFromID("0000000008F2D77ECE07A24EB6C27E0843C4B8880100CE3F23E508AB4F4A9A91BD99E6604421000000004C380000")

    Dim Filter As String
        Filter = "@SQL=" & Chr(34) & _
                 "http://schemas.microsoft.com/mapi/proptag/0x10900003" & _
                           Chr(34) & ">1"

    Dim Items As Outlook.Items
    Set Items = Completed_Fldrs.Items.Restrict(Filter)

    Dim Mail As MailItem

    Dim i As Long
    For i = Items.Count To 1 Step -1
        DoEvents
        If TypeOf Items(i) Is Outlook.MailItem Then
            Set Mail = Items(i)
            Debug.Print Mail.Subject
            Mail.FlagStatus = olFlagComplete
            Mail.Save
        End If
    Next
'Now you repeat for another folder
    Set Completed_Fldrs = olNs.GetFolderFromID("TheNewID")
    Filter = "The new filter"
    Set Items = Completed_Fldrs.Items.Restrict(Filter)
    For i = Items.Count To 1 Step -1
        DoEvents
        If TypeOf Items(i) Is Outlook.MailItem Then
            Set Mail = Items(i)
            Debug.Print Mail.Subject
            Mail.FlagStatus = olFlagComplete
            Mail.Save
        End If
    Next

End Function