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

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参数将附件添加为嵌入项。就我个人而言，在添加OlAttachmentType后采用代码时，我有运行时错误438。olEmbeddeditem作为第二个参数

还有一个附加联系人项而不是文件系统中的文件的例子。