Get Contact Information from Outlook

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!

Document last updated 2007-08-13 10:38:03