发送电子邮件并回复全部给它

Question

我的任务是发送一封包含报告的电子邮件，并通过回复/转发到已发送电子邮件的方式将另一封包含另一个报告的电子邮件发送到同一电子邮件线程（不包括某些收件人）。 p>

Option Explicit

Sub TestReply()

    Dim objApp As Application
    Dim objNewMail As Outlook.MailItem
    Dim objReply As Outlook.MailItem

    Set objApp = Outlook.Application
    Set objNewMail = objApp.CreateItem(0)

    ' Outgoing email
    With objNewMail
        .Subject = "Test sending email"
        .To = "abc@abc.com"
        .HTMLBody = "This is the outgoing email."
        .Send
    End With

    ' Reply email
    Set objReply = objNewMail.ReplyAll
    With objReply
        .HTMLBody = "This is the reply emal."
        .Display
    End With

    Set objApp = Nothing
    Set objNewMail = Nothing
    Set objReply = Nothing
End Sub

我找不到发送后续电子邮件的方法（通过回复或转发）。

当我尝试上面的代码时，它说错误该项目被移动/删除。我猜是因为在发送电子邮件时，objNewMail odject 也被终止了。

我尝试将 RE: 或 FW: 添加到原始电子邮件的主题中，但两封电子邮件将不在同一个线程中，而是在独立的电子邮件中。 p>

另一个问题是我在 Outlook 中有两个电子邮件帐户：我自己的电子邮件和团队电子邮件，并且报告将从 团队 电子邮件。

Answer 1

您可以确定添加到已发送文件夹的项目是否与 objNewMail 匹配。

在这个 Outlook 会话中

Option Explicit

Private WithEvents sentFolderItems As Items

Private Sub Application_Startup()

    'Set sentFolderItems = Session.GetDefaultFolder(olFolderSentMail).Items

    ' Reference any folder by walking the folder tree
    '  assuming the team folder is in the navigation pane
    Set sentFolderItems = Session.folders("team mailbox name").folders("Sent").Items

End Sub


Private Sub sentFolderItems_ItemAdd(ByVal Item As Object)

    Dim myReplyAll As MailItem

    If Item.Class = olMail Then

        'do not use InStr unless you change some part of words in original subject
        ' or another reply will be generated
        If Item.Subject = "Test sending email" Then
            Set myReplyAll = Item.ReplyAll

            With myReplyAll
                .HTMLBody = "This is the reply email."
                .Display
            End With
        End If

    End If

End Sub


Sub TestReply()

    Dim objNewMail As MailItem

    'Set objNewMail = CreateItem(olMailItem)

    ' Add, not create, in non-default folder
    Set objNewMail = Session.folders("team mailbox name").folders("Inbox").Items.Add

    ' Outgoing email
    With objNewMail
        .Subject = "Test sending email"
        .To = "abc@abc.com"
        .HTMLBody = "This is the outgoing email."
        .Send
    End With

End Sub

注意：当代码在 Outlook 中时，不需要 Application. 和 Outlook.。

Answer 2

仅在您构建回复之后在原始电子邮件 (objNewMail) 上调用 Send。

Answer 3

正确，目前您的代码正在执行此操作：

1. 创建邮件，发送。

2. 尝试回复已发送的mailitem对象。

你需要一个事件 Hook 来在你自己收到邮件时捕获它。 （假设这是您回复所有并删除报告 2 的一些收件人的方式）

以下是您完成此操作的方法：

首先创建一个 WithEvents 作为 Items 调用 AllMyItems，然后在 AllMyItems_ItemAdd 中创建一个钩子，然后在 Outlook 启动时使用 Application_Startup（内置事件）初始化事件

要非常小心地确定转发/处理传入邮件项目的标准，因为此事件代码将扫描发送到您的主收件箱的每封邮件并对其进行评估。如果您想进一步降低将邮件转发给错误的人的风险，请考虑使用 Outlook 规则将其分类到自定义文件夹中，然后将该文件夹的位置设置为 Set AllMyItems = 行而不是默认文件夹

Option Explicit
'for the Default DL inbox
Private WithEvents AllMyItems As Items

Private Sub Application_Startup()
  Dim olapp As Outlook.Application
  Dim objNS As Outlook.NameSpace
  Set olapp = Outlook.Application
  Set objNS = olapp.GetNamespace("MAPI")
  'Set myolitems = objNS.GetDefaultFolder(olFolderInbox).Items

    'all my items in the main box
    Set AllMyItems = objNS.GetDefaultFolder(olFolderInbox).Items
    Set olapp = Nothing
    Set objNS = Nothing
 End Sub

Private Sub AllMyItems_ItemAdd(ByVal Item As Object)
  On Error Resume Next
  If TypeName(Item) <> "Mailitem" Then
  If TypeName(Item) = "ReportItem" Then GoTo 0 'undeliverables shows as a report item
  If TypeName(Item) = "MeetingItem" Then GoTo 0

  Dim oItem As MailItem
  Dim myForward As MailItem
  Set oItem = Item
  'use the next line to check for a property of the incoming mail, that distinguishes it from other mail, since this event will run on every mail item
  If InStr(1, oItem.Subject, "Your public folder is almost full", vbTextCompare) > 0 Then
    Set myForward = oItem.Forward
    myForward.Recipients.Add "derp@derpinacorp.com"
    myForward.Importance = olImportanceHigh
    'MsgBox "uno momento"
    myForward.Send

  Else

  End If

  Else

  End If
  0:
End Sub