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:
- Right click on Project1 and choose Insert > Module
- Copy and paste the macro into the new module.
- 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
This works fine with saved contacts. How would I do the same for contacts in the global address book?
You need to use different code. :) This macro has an example of how to read the gal using VBA
Use VBA to Create a List of Exchange GAL Members (slipstick.com)
Getting the error of - Dim DataObj As MSForms.DataObject
I using with Outlook 2013.
You need set a reference to the Forms library in Tools, References. If its not listed, add C:\Windows\System32\FM20.dll or C:\Windows\FM20.dll as a reference. (I update the instructions to include this and a screenshot).