Outlook First Name

[meboe]

Currently I am using the login id (username) to personalize an Excel Macro.

Application.UserName + " --- Please Stand By while the page layout is formatted."

Can I instead call up the User's first Name, say from Outlook?

Thanks, Greg

 

[DonkeyOte]

Currently I am using the login id (username) to personalize an Excel Macro.

Application.UserName + " --- Please Stand By while the page layout is formatted."

Can I instead call up the User's first Name, say from Outlook?

Thanks, Greg

Greg - Application.Username is not a login user name rather it is the user of Excel set up in Tools - Options. Quite often this is blank unless users have been told to enter themseleves in there.

Environ("Username") extracts the NT login.

As for your Outlook request - the below extracts a specific address list and extracts the full name of the user on the basis of a look up using the NT login. In short it extracts the full details from the address book and then trims it to return the login only, then in an adjacent column it returns the full name - you can then run a vlookup in VBA of the Environ("Username") to determine the full name of the user....if you wanted to you could trip the Fullname to a forename using an InStr search. This requires the Outlook Object Library to be referenced in VBA.

Sub Standard()

Dim objOutlook As Outlook.Application
Dim objAddressList As Outlook.AddressList
Dim objAddressEntry As Outlook.AddressEntry

'Setup connection to Outlook application
Set objOutlook = CreateObject("Outlook.Application")
Set objAddressList = objOutlook.Session.AddressLists("Global Address List")

Application.ScreenUpdating = False

Sheets("OUTLOOK").Visible = True
Sheets("OUTLOOK").Select

'Clear existing list
Sheets("OUTLOOK").Range("A:B").Clear

n = 0

'Step through each entry in List and return full address to A
'Step through each entry in List and return name to B
For Each objAddressEntry In objAddressList.AddressEntries
If objAddressEntry.Address <> "" Then
n = n + 1
Sheets("OUTLOOK").Cells(n, 1) = objAddressEntry.Address
Sheets("OUTLOOK").Cells(n, 2) = objAddressEntry.Name
End If
Next objAddressEntry

'Reduce Full Address to Login
n = 1
x = InStrRev(Cells(n, 1), "=")

Do Until Cells(n, 1) = ""
Cells(n, 1) = Right(Cells(n, 1), (Len(Cells(n, 1)) - x))
n = n + 1
Loop

Cuser = Environ("Username")
CName = Application.WorksheetFunction.VLookup(Cuser, Sheets("OUTLOOK").Range("A:B"), 2, 0)

End Sub