从数组添加附件，而不创建文件路径

Question

我想合并草稿电子邮件中的附件（由另一个程序自动创建），这样一封电子邮件可能包含多个附件。

我有三个数组：

• 附件arrAtt()（来自原始电子邮件草稿）
• 原稿对应邮箱arrAdd()
• 唯一的电子邮件地址arrUnqAdd()

我正在为每个唯一的电子邮件地址创建一个新电子邮件。

我的挑战是从数组arrAtt() 添加附件。

我知道.Attachments.Add 是用来处理文件路径的。

有没有办法从arrAtt() 添加附件？即不保存附件以创建文件路径？

Dim OpenItem As Object
Dim arrDraft() As MailItem 'all drafts
Dim arrAtt() As Attachment 'all attachments
Dim arrAdd() As String 'all email addresses
Dim arrUnqAdd() As String 'unique email addresses
Dim strAddrUnique As String  'unique list of email addresses, delimited

For a = Application.Inspectors.Count To 1 Step -1
    Set OpenItem = Application.Inspectors(a).CurrentItem
    If TypeOf OpenItem Is MailItem Then
        If OpenItem.Subject Like "*New*Invoice*" Then
            b = b + 1
            ReDim Preserve arrDraft(1 To b)
            Set arrDraft(b) = OpenItem
        End If
    End If
Next

ReDim Preserve arrAtt(1 To UBound(arrDraft))
ReDim Preserve arrAdd(1 To UBound(arrDraft))

For a = 1 To UBound(arrDraft)
    arrAdd(a) = arrDraft(a).To
    If Not strAddrUnique Like "*" & arrDraft(a).To & "*" Then _
        strAddrUnique = strAddrUnique & IIf(Len(strAddrUnique) = 0, "", "/") & arrDraft(a).To
    Set arrAtt(a) = arrDraft(a).Attachments.Item(1)
Next

arrUnqAdd = Split(strAddrUnique, "/")

Dim NewMail As MailItem
For a = LBound(arrUnqAdd) To UBound(arrUnqAdd())
    Set NewMail = Application.CreateItem(olMailItem)
    NewMail.To = arrUnqAdd(a)
    For b = LBound(arrAdd) To UBound(arrAdd)
        If arrAdd(b) = arrUnqAdd(a) Then

            '****
            'HERE IS THE PROBLEM
            NewMail.Attachments.Add arrAtt(b) 
            '****

        End If
    Next
    Set NewMail.SendUsingAccount = NewAccount
    NewMail.Display
Next

End Sub

Answer 1

您可以尝试使用Type parameter 将附件添加为嵌入项目。就个人而言，在添加 OlAttachmentType.olEmbeddeditem 作为第二个参数后采用您的代码时，我遇到了运行时错误 438。

还有an example with attaching contact item instead of file from filesystem。