☰

使用 VBA 在 Outlook 中转发电子邮件

tag-icon • tag-icon email microsoft-outlook vba
使用 VBA 在 Outlook 中转发电子邮件

我正在尝试创建一个可以转发我收到的电子邮件的 vba。唯一的问题是我想要转发的电子邮件有不同的主题。只有开头是相同的。这是我目前所取得的进展（这应该插入到 ThisOutlookSession 中）。有人能帮帮我吗？

Public WithEvents objInbox As Outlook.Folder
Public WithEvents objInboxItems As Outlook.Items
Private Sub Application_Startup()
    Set objInbox = Outlook.Application.Session.GetDefaultFolder(olFolderInbox)
    Set objInboxItems = objInbox.Items
End Sub

Private Sub objInboxItems_ItemAdd(ByVal item As Object)
    Dim objMail As Outlook.MailItem
    Dim objForward As Outlook.MailItem

    If TypeOf item Is MailItem Then
       Set objMail = item

       'If it is a specific new email'
       If (objMail.Subject = "Offer Response Received") Then



           Set objForward = objMail.Forward
           'Customize the forward subject, body and recipients'
           With objForward
                .Subject = "Offer accepted"
                .HTMLBody = "<HTML><BODY>Please proceed. </BODY></HTML>" & objForward.HTMLBody
                .Recipients.Add ("")
                .Recipients.Add ("")
                .Recipients.ResolveAll
                .Importance = olImportanceHigh
                .Send
           End With
       End If
    End If
End Sub

答案1

您可以检查主题中是否有与适用邮件共同的文本。

Private Sub objInboxItems_ItemAdd(ByVal item As Object)

    Dim objMail As MailItem
    Dim objForward As MailItem

    Dim beginStr As String
    Dim lenBegin As Long

    beginStr = "the common text at beginning of applicable mail"
    lenBegin = Len(beginStr)

    If TypeOf item Is MailItem Then

        Set objMail = item

        'New email where the "beginning is the same"
        If Left(objMail.Subject, lenBegin) = beginStr Then

            Set objForward = objMail.Forward

            'Customize the forward subject, body and recipients'
            With objForward
                .Subject = "Offer accepted"
                .HTMLBody = "<HTML><BODY>Please proceed. </BODY></HTML>" & objForward.HTMLBody
                '.recipients.Add ("")
                '.recipients.Add ("")
                .recipients.ResolveAll
                .Importance = olImportanceHigh
                .Display    '.Send
            End With

        End If
    End If

End Sub

相关内容