如何在Outlook 2010自定义表单中包括选定的电子邮件正文?

时间:2019-02-25 21:46:04

标签: vba outlook outlook-2010

我有一个自定义表单,用户收到特定电子邮件时将使用该表单。我有VBA来选择电子邮件并转发,但是我无法弄清楚如何在自定义表单的电子邮件正文中包含转发的电子邮件。


更新:对于试图完成此任务的迷失之魂,我已经找到了解决问题的方法。

Sub CustomForm_IncludesSelectedEmailBody()

Dim myOlApp As Application
Dim myNameSpace As NameSpace
Dim myFolder As MAPIFolder
Dim myItems As Items
Dim myItem As Object
Dim origEmail As MailItem


Set origEmail = ActiveExplorer.Selection(1)
Set myOlApp = CreateObject("Outlook.Application")
Set myNameSpace = myOlApp.GetNamespace("MAPI")
Set myFolder = _
    myNameSpace.GetDefaultFolder(olFolderTasks)
Set myItems = myFolder.Items
Set myItem = myItems.Add("IPM.Note.DL_MALC_R_V1")
'the "IPM.Note.DL_MALC_R_V1" is the custom form's file name


myItem.HTMLBody = origEmail.Forward.HTMLBody
'this attaches the body of the email you're viewing to your new, forwarded email
myItem.Subject = origEmail.Forward.Subject
'This includes the selected email's subject line in your new email.
myItem.To = "emailYouWantToSendTo@example.com"
myItem.Display

Set myOlApp = Nothing
Set myNameSpace = Nothing
Set myFolder = Nothing
Set myItems = Nothing
Set myItem = Nothing
Set CustomForm = Nothing

End Sub

要创建用于运行VBA的按钮,就像自定义功能区并选择要从此处运行的宏一样简单。

/结束更新的答案


基本上我想发生的是:

  1. 用户单击一个加载我的自定义表单的按钮
  2. 在步骤1中单击按钮后,所选或查看的电子邮件将包含在自定义表单的电子邮件正文中。

我的想法是,我将下面的2个代码部分与以下内容结合在一起

Sub Combined()
    RunMyForm
    Forward
    'gets the forwarded email in the Forward sub, but doesnt include the body of the forwarded email in the custom form.
End Sub

,并且它可以工作,但是那没有发生。我是VBA的新手,所以我确定我在这里遗漏了一些东西。

创建按钮不是问题,因为在Outlook内很容易做到。我在下面的 Sub Combined()中列出了2个代码部分。

  1. VBA提取自定义表单。
Sub RunMyForm()
  Dim myOlApp As Application
  Dim myNameSpace As NameSpace
  Dim myFolder As MAPIFolder
  Dim myItems As Items
  Dim myItem As Object

  Set myOlApp = CreateObject("Outlook.Application")
  Set myNameSpace = myOlApp.GetNamespace("MAPI")
  Set myFolder = _
    myNameSpace.GetDefaultFolder(olFolderTasks)
  Set myItems = myFolder.Items
  Set myItem = myItems.Add("IPM.Note.Test1")
  myItem.Display

  Set myOlApp = Nothing
  Set myNameSpace = Nothing
  Set myFolder = Nothing
  Set myItems = Nothing
  Set myItem = Nothing
End Sub
  1. 选择当前查看的项目,将其转发并转发到特定的电子邮件地址。
Sub Forward()
'Combined with function GetcurrentItem, this forwards the selected email
    Dim fwd As Outlook.MailItem
    Dim itm As Object

    Set itm = GetCurrentItem()
    If Not itm Is Nothing Then
        Set fwd = itm.Forward
        fwd.Recipients.Add "email@exampleemail.com"
        fwd.Display
    End If

    Set fwd = Nothing
    Set itm = Nothing
End Sub
Function GetCurrentItem() As Object
    Dim objApp As Outlook.Application

    Set objApp = CreateObject("Outlook.Application")
    On Error Resume Next
    Select Case TypeName(objApp.ActiveWindow)
        Case "Explorer"
            Set GetCurrentItem = objApp.ActiveExplorer.Selection.Item(1)
        Case "Inspector"
            Set GetCurrentItem = objApp.ActiveInspector.CurrentItem
        Case Else
            ' anything else will result in an error, which is
            ' why we have the error handler above
    End Select

    Set objApp = Nothing
End Function

1 个答案:

答案 0 :(得分:0)

(在此处张贴,以便我将问题标记为已回答。对不起,我是Stackoverflow的新手。)

更新:对于试图完成此任务的迷失之魂,我已经找到了解决问题的方法。

Sub CustomForm_IncludesSelectedEmailBody()

Dim myOlApp As Application
Dim myNameSpace As NameSpace
Dim myFolder As MAPIFolder
Dim myItems As Items
Dim myItem As Object
Dim origEmail As MailItem


Set origEmail = ActiveExplorer.Selection(1)
Set myOlApp = CreateObject("Outlook.Application")
Set myNameSpace = myOlApp.GetNamespace("MAPI")
Set myFolder = _
    myNameSpace.GetDefaultFolder(olFolderTasks)
Set myItems = myFolder.Items
Set myItem = myItems.Add("IPM.Note.CustomForm1")
'the "IPM.Note.CustomForm1" is the custom form's file name


myItem.HTMLBody = origEmail.Forward.HTMLBody
'this attaches the body of the email you're viewing to your new, forwarded email
myItem.Subject = origEmail.Forward.Subject
'This includes the selected email's subject line in your new email.
myItem.To = "emailYouWantToSendTo@example.com"
myItem.Display

Set myOlApp = Nothing
Set myNameSpace = Nothing
Set myFolder = Nothing
Set myItems = Nothing
Set myItem = Nothing
Set CustomForm = Nothing

End Sub