Get contact information from Outlook
2007-08-13 Import & Export 0 376
The example function below can be used to retrieve contact information from your Outlook Contact folder, you only have to supply the contacts full name and the information you want the function to return. The function can be expanded to be able to return all stored contact information.
Function GetContactInfoFromOutlook(strFullName As String, strReturnItem As String) As String
' use like this in a worksheet cell, assuming cell A1 contains a name:
' =GetContactInfoFromOutlook(A1,"E-mail")
' =GetContactInfoFromOutlook(A1,"Phone")
' =GetContactInfoFromOutlook(A1,"Mobile")
Dim OLF As Object, olContactItem As Object
Dim OK As Boolean, i As Long, strResult As String
On Error Resume Next
Set OLF = GetObject("", "Outlook.Application").GetNamespace("MAPI").GetDefaultFolder(10)
If OLF Is Nothing Then
Set OLF = CreateObject("Outlook.Application").GetNamespace("MAPI").GetDefaultFolder(10)
End If
On Error GoTo 0
If Not OLF Is Nothing Then
With OLF
OK = False
i = 0
Do While i < .Items.Count And Not OK
i = i + 1
On Error Resume Next
Set olContactItem = .Items(i)
On Error GoTo 0
If Not olContactItem Is Nothing Then
With olContactItem
If .FullName = strFullName Then
OK = True
Select Case LCase(strReturnItem)
Case "mail", "e-mail"
strResult = .Email1Address
Case "phone", "home phone"
strResult = .HomeTelephoneNumber
Case "mobile", "cell", "cellphone", "carphone"
strResult = .MobileTelephoneNumber
' add more if necessary
Case Else ' default result
strResult = .Email1Address
End Select
End If
End With
Set olContactItem = Nothing
End If
Loop
End With
Set OLF = Nothing
End If
GetContactInfoFromOutlook = strResult
End Function
Note: The Outlook macro virus protection alert message box will be displayed when this function is used!