Excel VBA attaching emails within an email

Question

I am working on a project where I need to "draft" 5 emails, attach them to another email, and then send this nested email to a coworker.

My issue is that the 5 attached emails do not show a subject line. I wrote a little tester where the subject lines are also lost during the attaching

Private Sub emailtest()
    'Declare Variables
    Dim EmailMain As Outlook.MailItem
    Dim EmailSub As Outlook.MailItem
    Dim j As Long
    
    'Create the main email object
    Set EmailMain = Outlook.CreateItem(olMailItem)
    
    With EmailMain
        .To = "[email protected]"
        .Subject = "Testing Main"
        .Body = "testing testing"
    End With
    
    'creating 5 email objects
    For j = 1 To 5

        'Create the sub email to be attached to the main email
        Set EmailSub = Outlook.CreateItem(olMailItem)
        
        'Details for this sub email
        With EmailSub
            .To = ""
            .Subject = "Test: " & j
            .Body = "Testing Nest: " & j
        End With
        
        'Attach the email to the main email
        EmailMain.Attachments.Add EmailSub
    
    Next j

    EmailMain.Display
End Sub

After running this the displayed email has 5 emails, but they are all blank. No subject, no body, nothing.

Any help is appreciated.

Answer 1

You need to save the message being added as an attachment before it is attached:

EmailSub.Save
EmailMain.Attachments.Add EmailSub