☰

VBA para reenviar correos electrónicos en Outlook

tag-icon • tag-icon email microsoft-outlook vba
VBA para reenviar correos electrónicos en Outlook

Estoy intentando crear un vba que pueda reenviar los correos electrónicos que recibí. El único problema es que los correos electrónicos que me gustaría reenviar tienen asuntos diferentes. Sólo el comienzo es el mismo. Esto es lo lejos que he llegado (esto debería insertarse en ThisOutlookSession). ¿Alguien podría ayudarme por favor?

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

Respuesta1

Puede consultar el asunto del texto común del correo correspondiente.

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

información relacionada