VBA: Get All Contact Details

AndyZ wanted to share his macro with us:

I often need to copy a Contact's details to share with others and to put into appointments. I've used Copy2Contact in the past but it is limited and buggy, and now is very expensive since they converted to a subscription model. Anyway after updating to Windows 10 and Outlook 2016 (which you helped me with) I cast about for a way to replace Copy2Contacts "copy details" functionality. Your code helped me figure it out.

This macro displays the selected contact's details in a dialog box and copies them to the clipboard, ready to paste into other applications.

Public Sub GetAllContactDetails()
Dim Session As Outlook.NameSpace
Dim currentExplorer As Explorer
 
Dim obj As Object
Dim DataObj As MSForms.DataObject
Dim strContactDetails As String
Set DataObj = New MSForms.DataObject
 
Set currentExplorer = Application.ActiveExplorer
Set obj = currentExplorer.Selection.Item(1)
 
If obj.Class = olContact Then
 
    With obj
 
        If .FullName <> "" Then strContactDetails = .FullName & vbCrLf
        If .JobTitle <> "" Then strContactDetails = strContactDetails & .JobTitle & vbCrLf
        If .Department <> "" Then strContactDetails = strContactDetails & .Department & vbCrLf
        If .CompanyName <> "" Then strContactDetails = strContactDetails & .CompanyName & vbCrLf
        If .MailingAddress <> "" Then strContactDetails = strContactDetails & .MailingAddress & vbCrLf
        If .BusinessAddressCountry <> "" Then strContactDetails = strContactDetails & .BusinessAddressCountry & vbCrLf
        If .BusinessTelephoneNumber <> "" Then strContactDetails = strContactDetails & "Business: " & .BusinessTelephoneNumber & vbCrLf
        If .Business2TelephoneNumber <> "" Then strContactDetails = strContactDetails & "Business 2: " & .Business2TelephoneNumber & vbCrLf
        If .CompanyMainTelephoneNumber <> "" Then strContactDetails = strContactDetails & "Company: " & .CompanyMainTelephoneNumber & vbCrLf
        If .MobileTelephoneNumber <> "" Then strContactDetails = strContactDetails & "Mobile: " & .MobileTelephoneNumber & vbCrLf
        If .Email1Address <> "" Then strContactDetails = strContactDetails & .Email1Address & vbCrLf
        If .WebPage <> "" Then strContactDetails = strContactDetails & "Company Page: " & .WebPage & vbCrLf
        If .FTPSite <> "" Then strContactDetails = strContactDetails & "LinkedIn Page: " & .FTPSite & vbCrLf
        If .Body <> "" Then strContactDetails = strContactDetails & vbCrLf
        If .Body <> "" Then strContactDetails = strContactDetails & .Body & vbCrLf
 
    MsgBox strContactDetails
 
    DataObj.SetText strContactDetails
    DataObj.PutInClipboard
 
    End With
 
Else
MsgBox "You need to select a Contact."
End If
 
Set currentExplorer = Nothing
Set obj = Nothing
 
End Sub

How to Use Macros

First: You will need macro security set to low during testing.

To check your macro security in Outlook 2010 and above, go to File, Options, Trust Center and open Trust Center Settings, and change the Macro Settings. In Outlook 2007 and older, it’s at Tools, Macro Security.

After you test the macro and see that it works, you can either leave macro security set to low or sign the macro.

Open the VBA Editor by pressing Alt+F11 on your keyboard.

To put the code in a module:

1. Right click on Project1 and choose Insert > Module
2. Copy and paste the macro into the new module.
3. You will need to set a reference to the Forms library in Tools, References. If its not listed, click Browse and paste C:\Windows\System32\FM20.dll or C:\Windows\FM20.dll then press Enter to add one as a Reference.
   

More information as well as screenshots are at How to use the VBA Editor