PDA

View Full Version : Macro to pull outlook info based on excel values



absimg
05-16-2016, 02:03 AM
Hi there,
I would like to find out if its possible to pull outlook contact information (department, full name, company name, telephone number, alias, mobile number - in that order) from the global address book into Excel 2013 based on employee email address.
For example, in Column A I will have a range of email addresses and from there, run a macro to fill out the above mentioned fields.
I have the found the following code that pulls information based on User ID but I am having trouble modifying the code:
---
Public Sub GetUsers()
Dim myolApp As Outlook.Application
Dim myNameSpace As Namespace
Dim myAddrList As AddressList
Dim myAddrEntry As addressEntry
Dim AliasName As String
Dim i As Integer, r As Integer
Dim c As Range
Dim EndRow As Integer, n As Integer
Dim exchUser As Outlook.ExchangeUser
Set myolApp = CreateObject("Outlook.Application")
Set myNameSpace = myolApp.GetNamespace("MAPI")
Set myAddrList = myNameSpace.addressLists("Global Address List")
Dim FullName As String, LastName As String, FirstName As String
Dim HomeState As String, PhoneNum As String
Dim StartRow As Integer
EndRow = Cells(Rows.Count, 3).End(xlUp).Row
StartRow = InputBox("At which row should this start?", "Start Row", 2)
For Each c In Range("A" & StartRow & ":A" & CStr(EndRow))
AliasName = LCase(Trim(c))
c = AliasName
Set myAddrEntry = myAddrList.addressEntries(AliasName)
Set exchUser = myAddrEntry.GetExchangeUser
If Not exchUser Is Nothing Then
FirstName = exchUser.FirstName
LastName = exchUser.LastName
HomeState = exchUser.StateOrProvince
PhoneNum = exchUser.BusinessTelephoneNumber

End If
Next c
End Sub
---
Any assistance will be greatly appreciated :)