CODEWITHSUNDEEP
vbaoutlookoutlook-addinoutlook-2010
Menachem
Menachem

Reputation: 297

Extracting from new email in Outlook 2010 the native recipients' email addresses

The program below is extracting recipient email addresses from a newly composed email account in Outlook 2010. It then inserts them in the email body and it works fine.

However, I want to extract and insert the real addresses only. Now the program takes the addresses such as John Dow ([email protected]); John1 Dow ([email protected]) and inserts it in the email body as is.

What I need is to extract the address and insert only the addresses [email protected]; [email protected] without the full name that preceded each address.

Thanks for your help. Below is the code I am working with -

Sub copy_change() 'read the recepients of the new email and add them to the text body where the curser is.

Dim eRecipients As String

eRecipients = Application.ActiveInspector.currentItem.To

Dim objDoc As Word.Document, objSel As Word.Selection
On Error Resume Next

'~~> Get a Word.Selection from the open Outlook item
Set objDoc = Application.ActiveInspector.WordEditor
Set objSel = objDoc.Windows(1).Selection

'~~> Type Relevant Text
objSel.TypeText "Recipient : " & eRecipients

Set objDoc = Nothing
Set objSel = Nothing


End Sub

Upvotes: 0

Views: 80

Answers (1)

Dmitry Streblechenko
Dmitry Streblechenko

Reputation: 66215

Replace the line 

eRecipients = Application.ActiveInspector.currentItem.To

with

dim recip As Recipient
eRecipients = ""
for each recip in Application.ActiveInspector.CurrentItem.Recipients
  if Recip.Type = olTo Then
    if (eRecipients <> "") Then eRecipients  = eRecipients  & ", " 
    eRecipients = eRecipients & recip.Address
  End If
next

Upvotes: 1

Related Questions