从数组添加附件，而无需创建文件路径 [英] Add attachments from an array, without creating file paths

问题描述

我想合并电子邮件草稿中的附件(由另一个程序自动创建)，因此一封电子邮件中可能包含多个附件.

I want to amalgamate attachments that are in draft emails (auto-created by another program) so there is one email with possibly multiple attachments.

我有三个数组:

• 附件 arrAtt()(来自原始电子邮件草稿)
• 原始草案的相应电子邮件地址 arrAdd()
• 唯一的电子邮件地址 arrUnqAdd()

• attachments arrAtt() (from the original draft emails)
• original draft's corresponding email addresses arrAdd()
• unique email addresses arrUnqAdd()

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

I'm creating a new email for each unique email address.

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

My challenge is adding the attachments from the array arrAtt().

我了解到 .Attachments.Add 用于处理文件路径.

I get that .Attachments.Add is meant to work with file paths.

是否可以从 arrAtt()添加附件?即没有保存附件以创建文件路径?

Is there a way to add attachments from arrAtt()? i.e. without saving the attachments to create file paths?

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

推荐答案

您可以尝试使用

You can try to add attachment as embedded item using Type parameter. Personally I've had runtime error 438 when adopted your code after adding OlAttachmentType.olEmbeddeditem as second parameter.

此外，还有 查看全文