View Single Post
 
Old 06-21-2024, 03:51 AM
ndandge ndandge is offline Windows 7 64bit Office 2007
Novice
 
Join Date: Nov 2015
Posts: 9
ndandge is on a distinguished road
Default Word VBA code to retrieve email address from Outlook

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
Reply With Quote