Outlook VBA forward the selected email to the original sender’s email ID (including the email used in TO, CC Field) from the email chain

dreams

New Member
Outlook version
Outlook 2016 64 bit
Email Account
POP3
Hi All,

Can someone help me to achieve this VBA? I am not very familiar with VBA.

I would like to find the original sender's email address from the email chain of the “From:” Field (not from our inside organization emails like “@test.net”, “@testsupport.com” – check the attached image boxed in Green) and get it’s TO, CC fields on that email (including the inside organization emails if available on those TO & CC fields - boxed in Pink). Then forward that selected email to the original sender's email (need to add in the TO field - boxed in Green) and the remaining email address in the CC field boxed in Pink).

It will be much appreciated. Thank you.

I found the below codes online, and they are working fine. But it is getting email addresses from the "From"" field only. Also, I have no idea how to change this code to get the TO and CC fields of the original email and how to set it to forward the selected email. If someone can help me, It will be much appreciated and will save a lot of time on my end. Thank you.

Sub GetSenderFromSelectedEmailChainSource()

Dim olApp As Outlook.Application
Dim selectedEmail As Object
Dim olMailItem As Outlook.MailItem
Dim senderEmail As String
Dim internalDomainFound As Boolean


Set olApp = New Outlook.Application
Set selectedEmail = olApp.ActiveExplorer.Selection(1) ' Get the selected email
Set olMailItem = selectedEmail

If TypeOf olMailItem Is Outlook.MailItem Then
' Get the source code of the selected email
Dim sourceCode As String

sourceCode = olMailItem.HTMLBody


' Use regular expressions to find sender email addresses

Dim regex As Object

Set regex = CreateObject("VBScript.RegExp")

regex.Global = True

regex.IgnoreCase = True

' Define the pattern to match email addresses

regex.pattern = "\b[A-Za-z0-9._%+-]+@[A-Za-z0-9.-]+\.[A-Z|a-z]{2,7}\b"



' Find matches in the source code

Dim matches As Object

Set matches = regex.Execute(sourceCode)



' Iterate through matches to find the sender's email

Dim match As Object

For Each match In matches

senderEmail = match.Value

internalDomainFound = IsInternalDomain(senderEmail)



If Not internalDomainFound Then

Debug.Print "Sender Email from Source: " & senderEmail

Exit For

End If

Next match



If internalDomainFound Then

Debug.Print "No suitable sender email found in the source."

End If

End If



Set olApp = Nothing

Set selectedEmail = Nothing

Set olMailItem = Nothing

End Sub



Function IsInternalDomain(emailAddress As String) As Boolean

' Define your internal domain names here

Dim internalDomains() As String

internalDomains = Split("@test.net,@testsupport.com", ",")



Dim domain As String

domain = Right(emailAddress, Len(emailAddress) - InStr(emailAddress, "@"))



Dim i As Integer

For i = LBound(internalDomains) To UBound(internalDomains)

If LCase(domain) = LCase(internalDomains(i)) Then

IsInternalDomain = True

Exit Function

End If

Next i



IsInternalDomain = False

End Function

Image.jpg
 
@dreams. Your question is quite detailed and it's clear you've already done some groundwork with VBA. The code you've provided is a good start, but it's limited to extracting the sender's email address from the "From" field. Let's extend this functionality to also capture the "TO" and "CC" fields of the original email, and then forward the selected email to the original sender, while CC'ing the remaining email addresses.

Modified VBA Code​

Here's a modified version of your code that should meet your requirements:
Code:
Sub ForwardEmailToOriginalSender()
    Dim olApp As Outlook.Application
    Dim selectedEmail As Object
    Dim olMailItem As Outlook.MailItem
    Dim senderEmail As String
    Dim internalDomainFound As Boolean
    Dim originalTo As String
    Dim originalCC As String

    Set olApp = New Outlook.Application
    Set selectedEmail = olApp.ActiveExplorer.Selection(1)
    Set olMailItem = selectedEmail

    If TypeOf olMailItem Is Outlook.MailItem Then
        senderEmail = olMailItem.SenderEmailAddress
        internalDomainFound = IsInternalDomain(senderEmail)

        If Not internalDomainFound Then
            originalTo = olMailItem.To
            originalCC = olMailItem.CC

            Dim newMail As Outlook.MailItem
            Set newMail = olApp.CreateItem(olMailItem)
            newMail.Subject = "Fwd: " & olMailItem.Subject
            newMail.To = senderEmail
            newMail.CC = originalCC
            newMail.HTMLBody = olMailItem.HTMLBody
            newMail.Send
        End If
    End If

    Set olApp = Nothing
    Set selectedEmail = Nothing
    Set olMailItem = Nothing
End Sub

Function IsInternalDomain(emailAddress As String) As Boolean
    Dim internalDomains() As String
    internalDomains = Split("@test.net,@testsupport.com", ",")
    Dim domain As String
    domain = Right(emailAddress, Len(emailAddress) - InStr(emailAddress, "@"))
    Dim i As Integer

    For i = LBound(internalDomains) To UBound(internalDomains)
        If LCase(domain) = LCase(internalDomains(i)) Then
            IsInternalDomain = True
            Exit Function
        End If
    Next i

    IsInternalDomain = False
End Function

Explanation​

  1. olMailItem.SenderEmailAddress: This property directly gives you the sender's email address.
  2. olMailItem.To and olMailItem.CC: These properties provide the "TO" and "CC" fields of the email.
  3. olApp.CreateItem(olMailItem): Creates a new email item that you can modify and send.
This modified code should be more aligned with your requirements. It captures the "TO" and "CC" fields directly from the Outlook object model and uses them to forward the email to the original sender.

For further reading, you may refer to the Microsoft Outlook VBA documentation.

I hope this provides a comprehensive solution to your question. Feel free to test the code and make any necessary adjustments.
 
@house&o Thank you for your reply. I tried your code and I got a Runtime error "13" (Type mismatch) on the below line. Do you have any idea what I need to change?

Set newMail = olApp.CreateItem(olMailItem)
 
Similar threads
Thread starter Title Forum Replies Date
L Fetch, edit and forward an email with VBA outlook Outlook VBA and Custom Forms 2
H Forward E-mails at Certain Times in Outlook using VBA Outlook VBA and Custom Forms 1
J Outlook VBA to send from Non-default Account & Data Files Outlook VBA and Custom Forms 3
Geldner Problem submitting SPAM using Outlook VBA Form Outlook VBA and Custom Forms 2
P VBA to add email address to Outlook 365 rule Outlook VBA and Custom Forms 0
M Outlook 2016 outlook vba to look into shared mailbox Outlook VBA and Custom Forms 0
BartH VBA no longer working in Outlook Outlook VBA and Custom Forms 1
W Can vba(for outlook) do these 2 things or not? Outlook VBA and Custom Forms 2
richardwing Outlook 365 VBA to access "Other Actions" menu for incoming emails in outlook Outlook VBA and Custom Forms 0
J Outlook Rules VBA Run a Script - Multiple Rules Outlook VBA and Custom Forms 0
C Outlook (desktop app for Microsoft365) restarts every time I save my VBA? Using Outlook 1
E Outlook 365 Outlook/VBA Outlook VBA and Custom Forms 11
J VBA for outlook to compare and sync between calendar Outlook VBA and Custom Forms 1
E Outlook VBA change GetDefaultFolder dynamically Outlook VBA and Custom Forms 6
S vba outlook search string with special characters Outlook VBA and Custom Forms 1
U Outlook 2019 VBA run-time error 424 Outlook VBA and Custom Forms 2
G VBA to save selected Outlook msg with new name in selected network Windows folder Outlook VBA and Custom Forms 1
F Excel VBA to move mails for outlook 365 on secondary mail account Outlook VBA and Custom Forms 1
K Outlook Office 365 VBA download attachment Outlook VBA and Custom Forms 2
V vBA for searching a cell's contents in Outlook and retrieving the subject line Outlook VBA and Custom Forms 1
B vBA for exporting excel file from outlook 2016 Outlook VBA and Custom Forms 3
S Excel vba code to manage outlook web app Using Outlook 10
H Custom Outlook Contact Form VBA Outlook VBA and Custom Forms 1
S Problem Checking the available stores in my Inbox (Outlook VBA) Outlook VBA and Custom Forms 0
S Outlook VBA How to adapt this code for using in a different Mail Inbox Outlook VBA and Custom Forms 0
O VBA Outlook Message Attachment - Array Index Out of Bounds Outlook VBA and Custom Forms 0
J Want to learn VBA Macros for Outlook. What book can you recommend? Outlook VBA and Custom Forms 2
M Outlook 2013 reminder email by using Outlook vba Outlook VBA and Custom Forms 2
D Outlook VBA error extracting property data from GetRules collection Outlook VBA and Custom Forms 10
O Email not leaving Outbox when using Excel VBA to sync Outlook account Outlook VBA and Custom Forms 4
L Moving emails with similar subject and find the timings between the emails using outlook VBA macro Outlook VBA and Custom Forms 1
B Outlook Business Contact Manager with SQL to Excel, User Defined Fields in BCM don't sync in SQL. Can I use VBA code to copy 1 field to another? BCM (Business Contact Manager) 0
N How can I increase/faster outlook VBA Macro Speed ? Using Outlook 2
N Outlook Email Rule execution through shortcut keys (VBA codes) Using Outlook 1
A VBA Code in Outlook disappears after first use Outlook VBA and Custom Forms 1
dweller Outlook 2010 Rule Ignores VBA Script Outlook VBA and Custom Forms 2
G Outlook VBA and Google Calendar ("Events") Outlook VBA and Custom Forms 1
J VBA Outlook : Subject line : Cut and Paste name to heading , number to very end of the body of Email Outlook VBA and Custom Forms 1
B Advanced Search in MS Outlook by VBA and SQL Outlook VBA and Custom Forms 2
K Outlook Archive to PST Files by Date Range VBA Script? Outlook VBA and Custom Forms 1
J Help Please!!! Outlook 2016 - VBA Macro for replying with attachment in meeting invite Outlook VBA and Custom Forms 9
S Find a cell value in excel using outlook vba Using Outlook 1
J Execute Add-In Button from VBA Outlook 2016 Outlook VBA and Custom Forms 1
J Open an outlook email by Subject on MS Access linked table with VBA Outlook VBA and Custom Forms 10
D create an html table in outlook custom form 2010 using vba in MsAccess Outlook VBA and Custom Forms 7
M Slow VBA macro in Outlook Outlook VBA and Custom Forms 5
T Outlook AntiSpam with VBA Outlook VBA and Custom Forms 1
F "Move to" O365 feature to Outlook client via VBA Outlook VBA and Custom Forms 4
B query outlook using vba Outlook VBA and Custom Forms 13
J VBA to switch Outlook online/offline Outlook VBA and Custom Forms 4

Similar threads

Back
Top