使用 VBA 将附件添加到 Outlook 2016 中的所有选定项目答案

【问题标题】：Add attachment to all selected items in Outlook 2016 with VBA使用 VBA 将附件添加到 Outlook 2016 中的所有选定项目
【发布时间】：2018-12-04 11:52:34
【问题描述】：

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

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

草案测试 3
草案测试 2
草案测试 1

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

我是从这个开始的：

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 仅附加到草稿测试 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 仅附加到草稿测试 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 可能无法将同一个文件附加到多个草稿，因此我修改了最后一个测试以将不同的文件附加到每个草稿。只有草稿测试 3 执行后有附件。即使我将Application.ActiveExplorer.Selection 换成Application.ActiveExplorer.CurrentFolder.Items，仍然只有初稿有附件。

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

【问题讨论】：

如果您手动执行此操作，系统会提示您是否要保存。在Add 后面加上.Save。
@niton D'oh。那行得通。如果你把它放在答案中，我会接受。

标签： vba outlook email-attachments outlook-2016

【解决方案1】：

某些操作需要.Save。

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

【讨论】：

【解决方案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

现在将附件添加到每条选定的邮件中。

【讨论】：