Question

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

在“草稿”文件夹中，我有三个草稿，其中包含主题：

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

由于我所处的环境，我无法使用C＃。我改用VBA。我通过单击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仅附加到草稿测试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

同样，运行此代码后，仅草稿测试3附加了Test.txt。我以为Outlook可能无法将同一文件附加到多个草稿，所以我修改了最后一个测试以将不同的文件附加到每个草稿。执行后，只有草稿测试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中的所有选定项

2 个答案: