求助outlook vba发邮件添加附件

whhhit

求助 outlook vba发邮件，添加附件是 Attachments.Add “附件存放的路径”。我想把新收到邮件中的附件作为要发送邮件的附件，请问老师们这个怎么处理。谢谢。

Private Sub Application_NewMailEx(ByVal EntryIDCollection As String)
    Dim mai As Object
    Dim intInitial As Integer
    Dim intFinal As Integer
    Dim strEntryId As String
    Dim intLength As Integer

    Dim outapp As Object
    Dim outmail As Object

   Set outapp = Application.CreateObject("outlook.application")
   Set outmail = outapp.CreateItem(olMailItem)


    intInitial = 1
    intLength = Len(EntryIDCollection)
    intFinal = InStr(intInitial, EntryIDCollection, ",")
    Do While intFinal <> 0
        strEntryId = Strings.Mid(EntryIDCollection, intInitial, (intFinal - intInitial))
        Set mai = Application.Session.GetItemFromID(strEntryId)

        If mai.Subject = " " And mai.SenderName = " "  Then
            With outmail
                .To = mai.SenderEmailAddress
                .Subject = mai.Subject
                .Body = mai.Body
                .Attachments.add
                .Send
            End With
        End If

        intInitial = intFinal + 1
        intFinal = InStr(intInitial, EntryIDCollection, ",")
    Loop
    strEntryId = Strings.Mid(EntryIDCollection, intInitial, (intLength - intInitial) + 1)
    Set mai = Application.Session.GetItemFromID(strEntryId)
        If mai.Subject = " " And mai.SenderName = " "  Then
            With outmail
                .To = mai.SenderEmailAddress
                .Subject = mai.Subject
                .Body = mai.Body
                .Attachments.Add
                .Send
            End With
        End If
End Sub