使用 VBA 向 Outlook 2016 中的所有选定项目添加附件

Question

我的目标是为当前在 Outlook 2016 中选择的每个项目添加附件。我的想法是在当前选择的每个项目上循环调用 Attachments.Add。

在我的草稿文件夹中，我有三个主题的草稿：

草稿测试 3
草稿测试 2
草稿测试 1

由于我所处的环境，我无法使用C#。我正在使用 VBA 代替。我运行所有测试代码点击Developer > Macros > [sub name]在 Outlook 2016 功能区中。

我从这个开始：

Sub AddTestTxtToSelection1()
    Dim i As Long
    With Application.ActiveExplorer.Selection
        For i = .Count To 1 Step -1
            .Item(i).Attachments.Add "C:\Full\Path\To\Test.txt", olByValue, 1
        Next
    End With
End Sub

不幸的是，Test.txt 仅附加到 Draft Test 3，尽管所有三个草稿都被选中。我认为我可能会错误地迭代选择，所以我尝试了这个：

Sub AddTestTxtToSelection2()
    For Each objMessage In Application.ActiveExplorer.Selection
        objMessage.Attachments.Add "C:\Full\Path\To\Test.txt", olByValue, 1
    Next
End Sub

同样，虽然所有三个草稿都被选中，但 Test.txt 仅附加到 Draft Test 3。在 this article、Application.ActiveExplorer 及其 Selection 中的示例代码中属性存储在单独的变量中。我认为这可能是缺少的东西，所以我写了这个：

Sub AddTestTxtToSelection3()
    Dim myOlExp As Explorer
    Dim myOlSel As Selection
    Set myOlExp = Application.ActiveExplorer
    Set myOlSel = myOlExp.Selection
    Dim i As Long
    For i = 1 To myOlSel.Count
        myOlSel.Item(i).Attachments.Add "C:\Full\Path\To\Test.txt", olByValue, 1
    Next
End Sub

该行为与前两个测试的行为相同。最后，我想到问题可能出在我循环浏览草稿时修改草稿。然后我写了这段代码，它在循环之前将所选项目的 EntryID 属性存储在一个单独的字符串数组中：

Sub AddTestTxtToSelection4()
    Dim i As Long
    Dim strEntryID As Variant
    Dim namespaceMAPI As NameSpace
    Dim objMessage As Object
    Dim selected() As String
    ' Copy the current selection into an array of EntryID strings.
    ReDim selected(1 To Application.ActiveExplorer.Selection.Count) As String
    For i = 1 To Application.ActiveExplorer.Selection.Count
        selected(i) = Application.ActiveExplorer.Selection.Item(i).EntryID
    Next
    ' Retrieve each item from its EntryID string.
    Set namespaceMAPI = Application.GetNamespace("MAPI")
    namespaceMAPI.Logon
    For Each strEntryID In selected
        Set objMessage = namespaceMAPI.GetItemFromID(strEntryID)
        objMessage.Attachments.Add "C:\Full\Path\To\Test.txt", olByValue, 1
    Next
End Sub

同样，只有 Draft Test 3 在运行此代码之后附加了 Test.txt。我认为 Outlook 可能无法将同一个文件附加到多个草稿，所以我修改了最后一个测试以将不同的文件附加到每个草稿。只有Draft Test 3执行后有附件。即使我将 Application.ActiveExplorer.Selection 换成 Application.ActiveExplorer.CurrentFolder.Items，仍然只有初稿有附件。

为什么 Outlook 不能一次将一个文件附加到多个邮件项目？有解决方法吗？

Answer 1

某些操作需要 .Save。

这可能与手动完成时需要保存的操作相关。在这种情况下，如果您要手动附加文件然后关闭草稿，系统会询问您是否应保存草稿。

Answer 2

我接受了@niton 的回答，但这是我添加 .Save:

后的代码

' Based on AddTestTxtToSelection2
Sub AddTestTxtToSelection5()
    For Each objMessage In Application.ActiveExplorer.Selection
        objMessage.Attachments.Add "C:\Full\Path\To\Test.txt", olByValue, 1
        objMessage.Save ' This line was added.
    Next
End Sub

现在附件会添加到每封选定的邮件中。

使用 VBA 向 Outlook 2016 中的所有选定项目添加附件

Add attachment to all selected items in Outlook 2016 with VBA

vba

outlook

email-attachments

outlook-2016