I am new VBA code user. I am using Microsoft office 365 and I am trying to create Word VBA code which will search names present in the word document in outlook contacts and retrieve email addresses in below format. Surname, Name ;
But instead of email address, I am receiving below text. How can I get actual email address (e.g.
nameSurname@gmail.com) instead of this text?
/o=ExchangeLabs/ou=Exchange Administrative Group....
I have created below word vba code.
Option Explicit Sub SendEmail() Dim Names As String Dim Doc As Word.Document Dim rng As Word.Range
Set Doc = ActiveDocument
Names = Selection.Text
Selection.Collapse Direction:=wdCollapseEnd
Selection.Move Unit:=wdStory, Count:=1
Selection.Text = vbNewLine
Dim OL As Outlook.Application
Dim EmailItem As Outlook.MailItem
Dim Rec As Outlook.Recipient
' Check if Outlook is already open
On Error Resume Next
Set OL = GetObject(, "Outlook.Application")
On Error GoTo 0
' If Outlook is not open, create a new instance
If OL Is Nothing Then
Set OL = New Outlook.Application
End If
Set EmailItem = OL.CreateItem(olMailItem)
With EmailItem
.Display
.CC = Names
' Ensure names are properly formatted
Dim RecipientsResolved As Boolean
RecipientsResolved = .Recipients.ResolveAll
If Not RecipientsResolved Then
MsgBox "One or more recipients could not be resolved. Please check the names and try again.", vbExclamation
End If
For Each Rec In .Recipients
Selection.Collapse Direction:=wdCollapseEnd
Selection.Text = Rec.Name & " <" & Rec.Address & ">; "
Selection.Collapse Direction:=wdCollapseEnd
Next Rec
End With
Set OL = Nothing
Set EmailItem = Nothing
End Sub