(Solved) – Remove Flag Status on two Folders

(solved)-–-remove-flag-status-on-two-folders

With the following Code I set Flag Status “Complete” to one defined Folder (ID) on Outlook Startup. Is it possible to define a second Folder with another ID and separated Filter for e.g. “<= 1" and with the Flagstatus "olNoFlag"?

I tried to duplicate the whole Code, rename the Function name and set another Foldername, but without success.


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("test@test.com")

    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


Leave a Reply

Your email address will not be published. Required fields are marked *