选择文件夹（收件箱）并在移动的电子邮件中执行宏

Question

我有一个宏，可将subfolder中的每封电子邮件移至收件箱，并且运行良好！ 但是，如何调用已移动的特定电子邮件的宏？

移动电子邮件的宏：

Public Sub Mover_Email()
'   // Declare your Variables
    Dim Inbox As Outlook.MAPIFolder
    Dim SubFolder As Outlook.MAPIFolder
    Dim olNs As Outlook.NameSpace
    Dim Item As Object
    Dim lngCount As Long
    Dim Items As Outlook.Items

    On Error GoTo MsgErr
'    Set Inbox Reference
    Set olNs = Application.GetNamespace("MAPI")
    Set Inbox = Application.Session.GetDefaultFolder(olFolderInbox).Folders("1 - Arquivos Temporarios")
    Set Items = Inbox.Items

'   // Loop through the Items in the folder backwards
    For lngCount = Items.count To 1 Step -1
        Set Item = Items(lngCount)

        Debug.Print Item.Subject

        If Item.Class = olMail Then
'           // Set SubFolder of Inbox
            Set SubFolder = olNs.GetDefaultFolder(olFolderInbox)
'           // Mark As Read
            Item.UnRead = False
'           // Move Mail Item to sub Folder
            Item.Move SubFolder
            'Call the macro for that email
            '************
            'Enter the macro here
            '************
        End If
    Next lngCount

MsgErr_Exit:
    Set Inbox = Nothing
    Set SubFolder = Nothing
    Set olNs = Nothing
    Set Item = Nothing

    Exit Sub

'// Error information
MsgErr:
    MsgBox "An unexpected Error has occurred." _
         & vbCrLf & "Error Number: " & Err.Number _
         & vbCrLf & "Error Description: " & Err.Description _
         , vbCritical, "Error!"
    Resume MsgErr_Exit
End Sub

我认为选择文件夹“收件箱”并在该电子邮件中执行宏可能有效，但是我不知道如何。

如果还有其他简单的解决方案，我希望这样做（例如可能不选择收件箱）。

Answer 1

在移动过程中丢失了对邮件的引用。

使用let Source = Excel.CurrentWorkbook(){[Name="Table1"]}[Content], #"Added Custom" = Table.AddColumn(Source, "Custom", each if [Column1] = null then [Column2] else [Column1]), #"Removed Columns" = Table.RemoveColumns(#"Added Custom",{"Column1", "Column2"}) in #"Removed Columns" 创建对移动邮件的引用。

Set movedItem = …

Answer 2

使用NameSpace.PickFolder method (Outlook)

示例

Set Inbox = Application.Session.PickFolder

您还可以将Subfolder设置为PickFolder，但将其移到循环之外

示例

Option Explicit
Public Sub Mover_Email()
'   // Declare your Variables
    Dim Inbox As Outlook.MAPIFolder
    Dim SubFolder As Outlook.MAPIFolder
    Dim olNs As Outlook.NameSpace
    Dim Item As Object
    Dim lngCount As Long
    Dim Items As Outlook.Items

    On Error GoTo MsgErr
'    Set Inbox Reference
    Set olNs = Application.GetNamespace("MAPI")
    Set Inbox = Application.Session.PickFolder

    Set Items = Inbox.Items

'   // Set SubFolder
    Set SubFolder = Application.Session.PickFolder

'   // Loop through the Items in the folder backwards
    For lngCount = Items.Count To 1 Step -1
        Set Item = Items(lngCount)

        Debug.Print Item.Subject

        If Item.Class = olMail Then
'           // Mark As Read
            Item.UnRead = False
'           // Move Mail Item to sub Folder
            Item.Move SubFolder
            'Call the macro for that email
            '************
            'Enter the macro here
            '************
        End If
    Next lngCount

MsgErr_Exit:
    Set Inbox = Nothing
    Set SubFolder = Nothing
    Set olNs = Nothing
    Set Item = Nothing

    Exit Sub

'// Error information
MsgErr:
    MsgBox "An unexpected Error has occurred." _
         & vbCrLf & "Error Number: " & Err.Number _
         & vbCrLf & "Error Description: " & Err.Description _
         , vbCritical, "Error!"
    Resume MsgErr_Exit
End Sub

---

要将选定的电子邮件移至收件箱，请尝试以下操作

Option Explicit
Public Sub Exampls()
    Dim olNs As Outlook.NameSpace
    Set olNs = Application.GetNamespace("MAPI")

    Dim Inbox  As Outlook.MAPIFolder
    Set Inbox = olNs.GetDefaultFolder(olFolderInbox)

    Dim Item As Object
    Set Item = ActiveExplorer.selection(1)

    Debug.Print Item.Parent

    If TypeOf Item Is Outlook.MailItem Then

        If Not Item.Parent = Inbox Then
           Item.Move Inbox
           MsgBox "Item Subject: " & Item.Subject & " Has Been Move to " & Inbox.Name
        Else
            MsgBox "Item already in " & Item.Parent
            Exit Sub
        End If

    Else
        MsgBox "Selection is not MailItem"
    End If

End Sub