legalhustler
Well-known Member
- Joined
- Jun 5, 2014
- Messages
- 1,171
- Office Version
- 365
- Platform
- Windows
Hi,
The following VBA code works well for the most part but just need slight changes to it and I don't know how to make them. The code basically extracts the field Email, Name, and Phone Number from Outlook GAL based on a defined name range with a list of alias names.
Example:
Alias (column A)……….Column B...……………………...Column C...………..Column D
STYPEGHE ………………..joe.smith@outlook.com.... smith, joe...…….914-270-0010
Changes needed:
1) Code is returning a # N/A for the three extracted fields/columns from row 65,0001 to the last row of the worksheet. This should be blank since there is no alias listed (in the adjacent column A)
2) Add a header for each column of the three fields such as Email, Name and Phone Number.
3) Some emails comes like joe.smith@outlook.com (there is always a period between the first and last name) and would like to capitalize the "J"and "S", some are already come in correct form so those shouldn't change.
Thanks in advance!
The following VBA code works well for the most part but just need slight changes to it and I don't know how to make them. The code basically extracts the field Email, Name, and Phone Number from Outlook GAL based on a defined name range with a list of alias names.
Example:
Alias (column A)……….Column B...……………………...Column C...………..Column D
STYPEGHE ………………..joe.smith@outlook.com.... smith, joe...…….914-270-0010
Changes needed:
1) Code is returning a # N/A for the three extracted fields/columns from row 65,0001 to the last row of the worksheet. This should be blank since there is no alias listed (in the adjacent column A)
2) Add a header for each column of the three fields such as Email, Name and Phone Number.
3) Some emails comes like joe.smith@outlook.com (there is always a period between the first and last name) and would like to capitalize the "J"and "S", some are already come in correct form so those shouldn't change.
Thanks in advance!
VBA Code:
Option Explicit
Sub GetExchangeUserDetailsFromAlias()
Dim str As String
Dim olApp As Object 'Outlook.Application
Dim olNameSpace As Object 'Outlook.Namespace
Dim olRecipient As Object 'Outlook.Recipient
Dim oEU As Object 'Outlook.ExchangeUser
Dim arrUsers(1 To 65000, 1 To 3) As String
Dim lngUser As Long
Dim rngAlias As Range, rngAliasList As Range
On Error Resume Next
Set olApp = GetObject(, "Outlook.Application")
If olApp Is Nothing Then
Set olApp = CreateObject("Outlook.Application")
End If
On Error GoTo 0
Set olNameSpace = olApp.GetNamespace("MAPI")
With Worksheets("Users")
Set rngAliasList = .Range("rngAliasList")
End With
For Each rngAlias In rngAliasList
lngUser = lngUser + 1
If Len(rngAlias.Value) > 0 Then
str = rngAlias.Value
Set olRecipient = olNameSpace.CreateRecipient(str)
olRecipient.Resolve
If olRecipient.Resolved Then
If olRecipient.AddressEntry.AddressEntryUserType = 0 Then 'olExchangeUserAddressEntry
Set oEU = olRecipient.AddressEntry.GetExchangeUser
If Not (oEU Is Nothing) Then
With oEU
arrUsers(lngUser, 1) = .PrimarySmtpAddress
arrUsers(lngUser, 2) = .Name
arrUsers(lngUser, 3) = .MobileTelephoneNumber
End With
End If
End If
End If
End If
Next rngAlias
rngAliasList.Offset(, 1).Resize(, 3).Value = arrUsers
Set olApp = Nothing 'Outlook.Application
Set olNameSpace = Nothing 'Outlook.Namespace
Set olRecipient = Nothing 'Outlook.Recipient
Set oEU = Nothing 'Outlook.ExchangeUser
If lngUser Then Erase arrUsers
Set rngAlias = Nothing
Set rngAliasList = Nothing
End Sub
