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）打开收件箱文件夹，从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

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

4 个答案: