Outlook VBA - перемещать почту при назначении категории - PullRequest
0 голосов
/ 29 января 2020

Я хотел бы переместить электронные письма в подпапку своего почтового ящика, когда я назначил ему категорию

. Я нашел следующий код из 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

1 Ответ

0 голосов
/ 30 января 2020

Я не знаю точно, почему, но сегодня это неожиданно начало работать, я несколько раз перезапускал Outlook, но после того, как мне нужно было принудительно закрыть Outlook сегодня утром, он начал работать. (Я даже не уверен, начал ли он работать сразу же из-за перезапуска или после короткого времени, вызванного чем-то другим)

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...