Outlook record copied to excel (Easily)

daniels012

Well-known Member
Joined
Jan 13, 2005
Messages
5,219
I there a method to get a contact's information to an excel worksheet using a macro?
If so, any help would be great.

Basically I need:
Cell C11 on the worksheet: Company
Cell C13 Address
Cell C14 City, State Zip 'I can be flexible here if the whole address needs to go above.
Cell C15 Phone
cell C17 Fax

Anyway, you get the idea.

Maybe create an input box or user form that would search Outlook contacts for the person I want and then enter the data as described above?

Thank You very much,
Michael
 

Excel Facts

Copy PDF to Excel
Select data in PDF. Paste to Microsoft Word. Copy from Word and paste to Excel.
This awesome. I really think this is what I need. Unfortunately, I am not sure how to apply my desired cells to be filled with this code???

Michael
 
Upvote 0
Ok got the funtion in the module to get it to work only...
I try to enter the company, because this is what the name in outlook is like:

Code:
Case "company"
                                    strResult = .Company

and it puts the default (the email address)?????

Any ideas
Michael
 
Upvote 0
njimack,
You know after digging around a bit I found this to work very well :!: :!:
8-)

Thank You,
Michael
 
Upvote 0
Here is what I used:
Code:
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

Michael
 
Upvote 0

Forum statistics

Threads
1,225,356
Messages
6,184,467
Members
453,235
Latest member
dirtisbrown17

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top