Excel VBA 在电子邮件中附加电子邮件

Excel VBA attaching emails within an email

我正在做一个项目,我需要“起草”5 封电子邮件,将它们附加到另一封电子邮件,然后将这封嵌套电子邮件发送给同事。

我的问题是附加的 5 封电子邮件没有显示主题行。我写了一个小测试器,其中主题行在附加过程中也丢失了

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 = "fake@fakeemail.org"
        .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

在运行这之后显示的邮件有5封邮件,但它们都是空白的。没有主题,没有 body,没有。

感谢任何帮助。

您需要将正在添加的邮件保存为附件,然后再附加:

EmailSub.Save
EmailMain.Attachments.Add EmailSub