Getting First/last name from Outlook via VBA

  • Thread starter Thread starter Ulrich Binswanger
  • Start date Start date
U

Ulrich Binswanger

Hi there!

I have a Excel sheet with a list of Outlook Aliases and I want to write the
First and last names for these Aliases from my Outlook adress book in this
sheet

How can I do that?

Thanks,

Binsi
 
Paste this code into one of your VBA Project modules in Excel, and run the
GetNamesFromGALUsingAlias macro after selecting the aliases in the
spreadsheet. Note that you must have Collaboration Data Objects installed;
you can do that through Office Setup - check the Outlook components for the
CDO entry. CDO is required - you cannot access first name and last name
values from AddressEntry objects with Outlook VBA

The code will enter the first name and last name values into two columns to
the right of the column with the aliases.

Option Explicit

Const CdoPR_GIVEN_NAME = &H3A06001E 'First (name)
Const CdoPR_SURNAME = &H3A11001E 'Last (name)

Sub GetNamesFromGALUsingAlias()
On Error Resume Next

Dim objSession As Object
Dim objAddList As Object
Dim objAddresses As Object, objAddress As Object
Dim objFields As Object, objField As Object
Dim strLastName As String, strFirstName As String
Dim objRange As Excel.Range, varValues() As Variant, intX As Integer,
strAlias As String

Set objRange = Selection

If objRange Is Nothing Then
MsgBox "Nothing is selected!"
Exit Sub
End If
varValues = objRange.Value2

Set objSession = CreateObject("MAPI.Session")
If Err.Number <> 0 then
MsgBox("CDO is not installed!")
Exit Sub
End If
objSession.Logon , , True, True

Set objAddList = objSession.AddressLists("Global Address List")
Set objAddresses = objAddList.AddressEntries

'LOOP THROUGH SELECTED CELLS TO GET THE ALIAS
For intX = LBound(varValues, 1) To UBound(varValues, 1)
strAlias = varValues(intX, 1)
For Each objAddress In objAddresses
If objAddress.Name = strAlias Then
Set objFields = objAddress.Fields
Set objField = objFields.Item(CdoPR_SURNAME)
If Not objField Is Nothing Then
strLastName = objField.Value
End If
Set objField = objFields.Item(CdoPR_GIVEN_NAME)
If Not objField Is Nothing Then
strFirstName = objField.Value
End If
'WRITE FIRST AND LAST NAME TO ADJACENT COLUMNS
Cells(intX, objRange.Column + 1).Value = strFirstName
Cells(intX, objRange.Column + 2).Value = strLastName
Exit For
End If
Next
Next
objSession.Logoff
Set objAddList = Nothing
Set objAddresses = Nothing
Set objAddress = Nothing
Set objSession = Nothing
Set objFields = Nothing
Set objField = Nothing
End Sub
 
Thanks for this solution

BUT

if I do that, I only get the name of the entry. When I try to compar
the alias with the name its always different of course. I need the nam
in the contact. I can't access the alias name etc.

How can I do that?

greetings, Bins
 
Thanks for this solution

BUT

if I do that, I only get the name of the entry. When I try to compar
the alias with the name its always different of course. I need the nam
in the contact. I can't access the alias name etc.

How can I do that?

greetings, Bins
 
...So I need a solution how to access each contact profile to read th
"Alias" and the "First name" and "Last Name".

Thank
 
...So I need a solution how to access each contact profile to read th
"Alias" and the "First name" and "Last Name".

Thank
 
If you configure your Contacts folder as an Outlook Address Book
(right-click the folder, Properties, Outlook Address Book, show...), then
that folder will be accessible by name as per my code sample. If the
"aliases" in your spreadsheet are different than the name data in the
Contact entry, then this code is of no use for you.

Alternately, you can rework the code to loop through ContactItems in your
Contacts folder and compare name properties against your spreadsheet aliases
to find the ones you want to extract name data from.
 
Back
Top