根据主题中的关键词将阅读窗格中的电子邮件分类到子文件夹中

Question

我正在尝试根据主题中的关键词将收件箱中的电子邮件分类到子文件夹中。

具体来说，我希望使用快捷方式 CTRL+alt+q后，阅读窗格中的电子邮件进入相应的子文件夹。
这还会触发一个消息框，其中包含单击“确定”或“取消”的选项。
“取消”将从子文件夹中删除电子邮件并再次将其放入收件箱。

快捷方式不起作用，SubjectFilter 代码给出错误消息

找不到对象

Sub CreateFilterShortcut()
    Application.OnKey "^%q", "SubjectFilter"
End Sub

Sub SubjectFilter()

    Dim iClick As Integer
     Dim olApp As Outlook.Application
     Dim objNS As Outlook.NameSpace
     Dim olFolder As Outlook.MAPIFolder
     Dim olMsg As Outlook.Items
 
     Set myOlExp = Application.ActiveExplorer
     Set olApp = Outlook.Application
     Set objNS = olApp.GetNamespace("MAPI")
     Set olFolder = objNS.GetDefaultFolder(olFolderInbox)
     Set olMsg = olFolder.Items
     Set myDestFolder1 = objNS.Folders("Folder1")
     Set myDestFolder2 = objNS.Folders("Folder2")

    If myOlExp.olMsg.IsPaneVisible(olPreview) = True Then
        If olMsg.Subject Like "*report1*" Then
            olMsg.Move myDestFolder1
            iClick = MsgBox(prompt:="Folder1", Buttons:=vbOKCancel)
          
        ElseIf olMsg.Subject Like "*report2*" Then
            olMsg.Move myDestFolder2
            iClick = MsgBox(prompt:="Folder2", Buttons:=vbOKCancel)
        End If
    End If
    
    If iClick = vbCancel Then
        MsgBox "Cancel"
        olMsg.Move olFolder
    Else
        MsgBox "Ok"
    End If
    
End Sub

Answer 1

您正在寻找

Folder1

的级别太高。你可以试试

Set myDestFolder1 = objNS.Folders("[email protected]").Folders("Folder1")

编辑：我使用“监视”窗口来确定 objNS 下可用的文件夹（如果这对您有帮助的话）

Answer 2

您的代码中有两项需要调查。

• olMsg 是一个内置常量。替换为

  olMessages

• 分配结果是一个集合，必须对其进行迭代。有

  For...Each loop

• 用户文件夹必须位于您的电子邮件文件夹之一下

Sub SubjectFilter()

 Dim iClick As Integer
 Dim olApp As Outlook.Application
 Dim objNS As Outlook.NameSpace
 Dim olFolder As Outlook.MAPIFolder
 Dim inMsg As Outlook.Items
 
 Set myOlExp = Application.ActiveExplorer
 Set olApp = Outlook.Application
 Set objNS = olApp.GetNamespace("MAPI")
 Set olFolder = objNS.GetDefaultFolder(olFolderInbox)
 Set olMessages = olFolder.Items          'edited
 Set myDestFolder1 = objNS.Folders("[email protected]").Folders("Folder1")  'edited
 Set myDestFolder2 = objNS.Folders("[email protected]").Folders("Folder2")  'edited


    'If myOlExp.olMsg.IsPaneVisible(olPreview) = True Then
    For each inMsg in olMessages        'inserted
    If inMsg.Subject Like "*report1*" Then   'edited
      inMsg.Move myDestFolder1               'edited
      iClick = MsgBox(prompt:="Folder1", Buttons:=vbOKCancel)
          
    ElseIf inMsg.Subject Like "*report2*" Then   'edited
      inMsg.Move myDestFolder2                   'edited 
      iClick = MsgBox(prompt:="Folder2", Buttons:=vbOKCancel)
    End If
    'End If
    next inMsg                'inserted

    If iClick = vbCancel Then
    MsgBox "Cancel"
    inMsg.Move olFolder          'edited
    Else
    MsgBox "Ok"
    End If
    
End Sub

在 Outlook 中没有 OnKey 方法。

无法声明用户定义的自定义快捷键或重新分配它们。有它的解决方法，例如https://superuser.com/questions/203294/custom-one-key-keyboard-shortcuts-in-outlook-2010-or-2013，它使用 AutoHotKey。

Answer 3

假设目标文件夹是默认收件箱的子文件夹。

Sub SubjectFilter()

    Dim olFolder As Folder
    Dim myDestFolder1 As Folder
    Dim myDestFolder2 As Folder
    
    Set olFolder = Session.GetDefaultFolder(olFolderInbox)
    Set myDestFolder1 = olFolder.Folders("Folder1")
    Set myDestFolder2 = olFolder.Folders("Folder2")
 
    Dim myOlExp As explorer
    Set myOlExp = ActiveExplorer
    
    Dim olMsg As Object
    
    If myOlExp.IsPaneVisible(olPreview) = True Then
    
        ' https://learn.microsoft.com/en-us/office/vba/api/Outlook.explorer.activeinlineresponse
        
        ' https://stackoverflow.com/a/71241179/1571407
        ' ActiveExplorer.ActiveInlineResponse is only shown when a user replies to or forwards a message.
        'Set olMsg = ActiveExplorer.ActiveInlineResponse
        
        'If olMsg Is Nothing Then
        Set olMsg = ActiveExplorer.selection(1)
        'End If
        
        Debug.Print olMsg.Subject
        
        If olMsg.Subject Like "*report1*" Then
            If MsgBox(prompt:="Folder1", Buttons:=vbOKCancel) = vbOK Then
                olMsg.Move myDestFolder1
            End If
            
        ElseIf olMsg.Subject Like "*report2*" Then
            If MsgBox(prompt:="Folder2", Buttons:=vbOKCancel) = vbOK Then
                olMsg.Move myDestFolder2
            End If
            
        End If
    
    End If
    
End Sub

反转移动需要引用已移动的项目，而不是原始项目。最好在搬家之前验证，而不是搬家之后。