Try this:
Code:
Enum OL_Info
CompanyName = 1
BusinessAddress = 2
BusinessAddressCity = 3
BusinessAddressState = 4
BusinessAddressPostalCode = 5
BusinessTelephoneNumber = 6
Email1Address = 7
End Enum
Function LM_Test(Name As String, Info As OL_Info) As String
Dim olA As Object 'Outlook.Application
Dim olNS As Object 'Namespace
Dim olAB As Object 'MAPIFolder
Dim lItem As Long
Dim sNameWanted As String
Dim sRetValue As String
Set olA = CreateObject("Outlook.Application")
Set olNS = olA.GetNamespace("MAPI")
Set olAB = olNS.GetDefaultFolder(olFolderContacts)
Application.Volatile
sNameWanted = rRng.Value
sRetValue = "Not Found"
On Error Resume Next
For lItem = 1 To olAB.Items.Count
With olAB.Items(lItem)
If sNameWanted = .FullName Then
Select Case Info
Case 1
sRetValue = .CompanyName
Case 2
sRetValue = .BusinessAddress
Case 3
sRetValue = .BusinessAddressCity
Case 4
sRetValue = .BusinessAddressState
Case 5
sRetValue = .BusinessAddressPostalCode
Case 6
sRetValue = .BusinessTelephoneNumber
Case 7
sRetValue = .Email1Address
End Select
End If
End With
Next lItem
olA.Quit
LM_Test = sRetValue
'Release Memory
Set olA = Nothing
Set olNS = Nothing
Set olAB = Nothing
lItem = Empty
sNameWanted = vbNullString
sRetValue = vbNullString
End Function
Or please check:
http://www.globaliconnect.com/excel/...=79&Itemid=475
Bookmarks