使用 VBA 在 Outlook 中激活特定电子邮件并从复制的文本中删除签名

Question

我希望在 vba 中使用 get 函数来激活 Outlook 中的特定电子邮件，然后将正文复制到新电子邮件中并发送。我可以使用getlast 函数来获取收件箱中的最新电子邮件，但是我想通过从特定电子邮件地址中选择最新电子邮件来进一步优化代码。

另外，我很想知道如何从粘贴到新电子邮件中的文本中删除签名。

Sub Negotiations()

Dim objMsg As Outlook.MailItem
Dim objItem As Outlook.MailItem
Dim BodyText As Object
Dim myinspector As Outlook.Inspector
Dim myItem As Outlook.MailItem
Dim NewMail As MailItem, oInspector As Inspector

Set myItem = Application.Session.GetDefaultFolder(olFolderInbox).Items.GetLast
myItem.Display

'copy body of current item

Set activeMailMessage = ActiveInspector.CurrentItem
activeMailMessage.GetInspector().WordEditor.Range.FormattedText.Copy

' Create the message.
Set objMsg = Application.CreateItem(olMailItem)

'paste body into new email
Set BodyText = objMsg.GetInspector.WordEditor.Range
BodyText.Paste

'set up and send notification email
With objMsg
    .To = "@gmail.com"
    .Subject = "Negotiations"
    .HTMLBody = activeMailMessage.HTMLBody
    .Display

End With
End Sub

任何帮助将不胜感激，谢谢你们！

Answer 1

使用 Namespace.GetDefaultFolder(olFolderInbox) 打开 Inbox 文件夹，从 MAPIFolder.Items 检索 Items 集合。对 ReceivedTime 属性上的项目 (Items.Sort) 进行排序，使用 SenderEmailAddress 属性上的 Items.Find 检索最新的电子邮件。

Answer 2

根据 .SenderEmailAddress 的属性返回的内容，您可以调整 while 语句的计算结果。这应该对您有用，首先查看最后一封电子邮件，然后检查之前的每封电子邮件以获取正确的发件人地址。

Sub display_mail()
    Dim outApp As Object, objOutlook As Object, objFolder As Object
    Dim myItems As Object, myItem As Object
    Dim strSenderName As String

    Set outApp = CreateObject("Outlook.Application")
    Set objOutlook = outApp.GetNamespace("MAPI")
    Set objFolder = objOutlook.GetDefaultFolder(olFolderInbox)
    Set myItems = objFolder.Items
    strSenderName = UCase(InputBox("Enter the e-mail Alias."))

    Set myItem = myItems.GetLast
    While Right(myItem.SenderEmailAddress, Len(strSenderName)) <> strSenderName
        Set myItem = myItems.GetPrevious
    Wend
    myItem.Display
End Sub

Answer 3

Application.Session.GetDefaultFolder(olFolderInbox).Items.GetLast activeMailMessage.GetInspector().WordEditor.Range.FormattedText.Copy

首先，我建议中断调用链。在单独的代码行上声明每个属性或方法调用，这样您就可以随时调试代码并查看幕后发生的情况。

GetLast 方法返回集合中的最后一个对象。但这并不意味着该项目是最后收到的。您需要使用 Sort 方法对集合进行排序，因为 Dmitry 建议将 ReceivedTime 属性作为参数传递以进行排序。只有在这种情况下，您才会从集合中获取最后收到的项目。

Outlook 对象模型不提供任何用于识别签名的特殊方法或属性。您需要解析消息正文并以编程方式找到它。

Answer 4

Sub Nego()

Dim objMsg As Outlook.MailItem
Dim myItem As Outlook.MailItem
Dim BodyText As Object
Dim Inspector As Outlook.MailItem
Dim olNameSpace As Outlook.NameSpace
Dim olfolder As Outlook.MAPIFolder

Dim msgStr As String
Dim endStr As String
Dim endStrStart As Long
Dim endStrLen As Long
Dim myItems As Outlook.Items



    'Access folder Nego
Const olFolderInbox = 6
    Set objOutlook = CreateObject("Outlook.Application")
    Set objNamespace = objOutlook.GetNamespace("MAPI")
    Set objInbox = objNamespace.GetDefaultFolder(olFolderInbox)
    strFolderName = objInbox.Parent
    Set objMailbox = objNamespace.Folders(strFolderName)
    Set objFolder = objMailbox.Folders("Nego")

    'Mark as read
For Each objMessage In objFolder.Items
    objMessage.UnRead = False
    Next

    'Sort
Set myItems = objFolder.Items
    For Each myItem In myItems
    myItems.Sort "Received", False
    Next myItem
    myItems.GetLast.Display

    'copy body of current item
Set activeMailMessage = ActiveInspector.CurrentItem
    activeMailMessage.GetInspector().WordEditor.Range.FormattedText.Copy

    ' Create the message.
Set objMsg = Application.CreateItem(olMailItem)

    'paste body into new email
Set BodyText = objMsg.GetInspector.WordEditor.Range
    BodyText.Paste

    'Search Body
Set activeMailMessage = ActiveInspector.CurrentItem
    endStr = "first line of signature"
    endStrLen = Len(endStr)
    msgStr = activeMailMessage.HTMLBody
    endStrStart = InStr(msgStr, endStr)
    activeMailMessage.HTMLBody = Left(msgStr, endStrStart + endStrLen)

    'set up and send email
With objMsg
    .To = "@email"
    .Subject = "Nego"
    .HTMLBody = activeMailMessage.HTMLBody
    .HTMLBody = Replace(.HTMLBody, "First line of signature", " ")
    .Send

End With


End Sub