Question

我想为电子邮件分配一个类别时将其移动到收件箱的子文件夹中

我从Extended Office找到了以下代码，但是它不起作用。应该将邮件移到与该类别同名的子文件夹中，并在不存在的情况下创建一个文件夹。

我已在Outlook的安全设置中启用了宏，并插入了一些消息框警报以确认确实可以运行。

代码在ThisOutlookSession中

    Private WithEvents xInboxFld As Outlook.Folder
Private WithEvents xInboxItems As Outlook.Items

Private Sub Application_Startup()

    MsgBox "Macros are working"

    Set xInboxFld = Outlook.Application.Session.GetDefaultFolder(olFolderInbox)
    Set xInboxItems = xInboxFld.Items
End Sub

Private Sub xInboxItems_ItemChange(ByVal Item As Object)

MsgBox "Item Changed"

Dim xMailItem As Outlook.MailItem
Dim xFlds As Outlook.Folders
Dim xFld As Outlook.Folder
Dim xTargetFld As Outlook.Folder
Dim xFlag As Boolean

On Error Resume Next

If Item.Class = olMail Then
    Set xMailItem = Item
    xFlag = False
    If xMailItem.Categories <> "" Then
        Set xFlds = Application.Session.GetDefaultFolder(olFolderInbox).Folders
        If xFlds.Count <> 0 Then
            For Each xFld In xFlds
                If xFld.Name = xMailItem.Categories Then
                    xFlag = True
                End If
            Next
        End If
        If xFlag = False Then
            Application.Session.GetDefaultFolder(olFolderInbox).Folders.Add xMailItem.Categories, olFolderInbox
        End If
        Set xTargetFld = Application.Session.GetDefaultFolder(olFolderInbox).Folders(xMailItem.Categories)
        xMailItem.Move xTargetFld
    End If
End If
End Sub

Answer 1

我不知道确切的原因，但是今天突然开始起作用，在此之前我已经重新启动了Outlook几次，但是在今天早晨我不得不强制关闭Outlook之后，它才开始起作用。（我什至不知道它是否由于重新启动而立即开始工作，还是之后不久又由其他原因触发）

Outlook VBA-在分配给类别时移动邮件

1 个答案: