传入消息的副本为空白答案

【问题标题】：Copy of incoming message is blank传入消息的副本为空白
【发布时间】：2021-10-08 23:27:12
【问题描述】：

我正在尝试复制带有附件的邮件并将其转发到指定地址。

Option Explicit
Private WithEvents inboxItems As Outlook.Items
Private Sub Application_Startup()
    Dim outlookApp As Outlook.Application
    Dim objectNS As Outlook.Account
      
    Set outlookApp = Outlook.Application
    'Set objectNS = outlookApp.GetNamespace("MAPI")
    'Set inboxItems = objectNS.GetDefaultFolder(olFolderInbox).Items
    Set objectNS = outlookApp.Session.Accounts.Item(2)
    Set inboxItems = objectNS.DeliveryStore.GetDefaultFolder(olFolderInbox).Items
End Sub
     
Private Sub inboxItems_ItemAdd(ByVal Item As Object)
    On Error GoTo ErrorHandler
    Dim Msg As Outlook.MailItem
    Dim MessageInfo
    Dim Result
    If TypeName(Item) = "MailItem" Then
        MsgBox ("debug msg")
        
        Dim oNS As Outlook.NameSpace
        Set oNS = Application.GetNamespace("MAPI")
        
        Dim myItem As Outlook.MailItem
        Dim myRecipient As Outlook.Recipient
        Set myItem = Application.CreateItem(olMailItem)
        Set myRecipient = myItem.Recipients.Add("mail@mail.com")
        myItem.Subject = Item.Subject
        myItem.SendUsingAccount = oNS.Accounts.Item(2)
        myItem.HTMLBody = Item.Body
        myItem.Display
        'myItem.Send
        
    End If
ExitNewItem:
    Exit Sub
ErrorHandler:
    MsgBox Err.Number & " - " & Err.Description
    Resume ExitNewItem
End Sub

脚本在启动时启动。
当收件箱中出现项目时触发该事件。
由于我有多个与 Outlook 相关联的帐户，因此我使用：

Set objectNS = outlookApp.Session.Accounts.Item(2)

邮件正文未复制（例如，文字+图片）。

我试过了：

myItem.HTMLBody = Item.RTFbody

或

myItem.HTMLBody = Item.HTMLbody

但是消息仍然是空白的。

【问题讨论】：

您能检查一下Item.HTMLbody 返回的内容吗？是空字符串吗？
我不是程序员，碰巧我不得不处理这个任务。如果我这样做myItem.HTMLBody = Item.HTMLbody 消息字段仍然是空的。我会尝试做MsgBox (Item.HTMLbody) 看看会发生什么。我可以稍后再做。

标签： vba outlook

【解决方案1】：

使用MailItem.Forward method (Outlook)

例子

Option Explicit
Public Sub Example()
    Dim Item As Outlook.MailItem
    Set Item = ActiveExplorer.Selection.Item(1)

    If TypeOf Item Is Outlook.MailItem Then
        Debug.Print Item.Subject
        FwItem Item
    End If

End Sub

Public Sub FwItem(ByVal Item As Object)
    Dim MsgFwd As Outlook.MailItem
    Set MsgFwd = Item.Forward
        MsgFwd.Subject = Item.Subject
        MsgFwd.Recipients.Add "0m3r@Email.com"
        MsgFwd.Save
        MsgFwd.HTMLBody = Item.HTMLBody
        MsgFwd.Send
End Sub

【讨论】：

tnx！它帮助了我。现在我有一个问题：我需要将附件复制到一个新的 MailItem。我尝试这样做：Dim myAttachments As Outlook.Attachments 和 myAttachments.Add Item.Attachments.Item(1) 但它不起作用
你能用你当前的代码发布新问题吗，@AndreyBaranov 我是来帮忙的

【解决方案2】：

邮件正文可能引用用于img 标签的隐藏附件。因此，如果您复制 HTMLBody 属性返回的标记，您还必须找到并重新附加正文中使用的图像。除此之外，您的代码看起来不错：

Private Sub inboxItems_ItemAdd(ByVal Item As Object)
On Error GoTo ErrorHandler
Dim Msg As Outlook.MailItem
Dim MessageInfo
Dim Result
If TypeName(Item) = "MailItem" Then
    MsgBox ("debug msg")

    Dim oNS As Outlook.NameSpace
    Set oNS = Application.GetNamespace("MAPI")

    Dim myItem As Outlook.MailItem
    Dim myRecipient As Outlook.Recipient
    Set myItem = Application.CreateItem(olMailItem)
    Set myRecipient = myItem.Recipients.Add("mail@mail.com")
    myItem.Subject = Item.Subject
    myItem.SendUsingAccount = oNS.Accounts.Item(2)
    myItem.HTMLBody = Item.HTMLBody
    myItem.Display
    'myItem.Send

End If
ExitNewItem:
    Exit Sub
ErrorHandler:
    MsgBox Err.Number & " - " & Err.Description
    Resume ExitNewItem
End Sub

作为一种解决方法，您可以使用MailItem 类的Reply 或Forward 方法。它们都返回一个代表新邮件项目的MailItem 对象。所以，没有必要复制任何东西。您只需要收件人，更正主题并调用Send 方法。例如：

Sub Forwarding()  
 Dim myinspector As Outlook.Inspector  
 Dim myItem As Outlook.MailItem  
 Dim myattachments As Outlook.Attachments  

 Set myinspector = Application.ActiveInspector  
 If Not TypeName(myinspector) = "Nothing" Then  
 Set myItem = myinspector.CurrentItem.Forward  

 ' myItem.Display  
 myItem.Recipients.Add "Eugene Astafiev"  
 myItem.Send 

 Else  
 MsgBox "There is no active inspector."  
 End If  
End Sub

【讨论】：