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

Question

使用以下代码，我将标志状态"完成"设置为一个定义的文件夹(ID(在Outlook启动。是否可以使用另一个ID和单独的过滤器定义第二个文件夹，例如"<= 1"和标志状态"olNoFlag"？

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

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("[e-mail]")
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("[e-mail]")
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