Copy a Contact's Mailing Address

One thing that annoys Outlook users (ok, one of many things!) is the lack of an envelope printing feature or even a quick and easy way to grab an address to use in another program. Yes, you can use the Insert Address control in Word to grab a Contact address from Outlook, but it's slow. Mail merge is slow and overkill for just one address.

Once again, a macro comes to the recue, copying the name and mailing address to the clipboard so you can use it in any program.

First, you need to set macro security to Low. Go to File, Options, Trust Center in Outlook 2010 or Outlook 2013, then click Macro Security and choose the lowest setting to allow the macro to run. (Later, you can sign it and raise the security level.)

To use, paste the macro into a new module and set a reference to the Microsoft Forms 2.0 Object Library object. To set the reference, go to Tools, References then click Browse and paste C:\Windows\System32\FM20.dll (or browse to find it) and click Open.

See How to use Outlook's VBA Editor for more information.

Go to File, Options, Customize Ribbon and select Macros from Show Commands From dropdown. On the right hand side of the screen, select the location where you want to put the button and click New Group. Select the GetMailingAddress macro and click Add to add it to the Group. Click Rename to give it a friendly name and a new icon.
Now select a contact and click the button to run the macro. A message box will popup containing the name, company name if available, and the mailing address. When you are done testing, comment out the MsgBox box line and sign the macro using selfcert then raise the macro security level, if desired.

Option Explicit
 
Public Sub GetMailingAddress()
    Dim Session As Outlook.NameSpace
    Dim currentExplorer As Explorer
     
    Dim obj As Object
    Dim DataObj As MSForms.DataObject
    Dim strAddress 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 .CompanyName <> "" Then
       strAddress = .FullName & vbCrLf & .CompanyName & vbCrLf & .MailingAddress
     Else
       strAddress = .FullName & vbCrLf & .MailingAddress
     End If
    
     MsgBox strAddress
    
    DataObj.SetText strAddress
    DataObj.PutInClipboard

     End With
    
   Else
    MsgBox "You need to select a Contact."
   End If
 
    Set currentExplorer = Nothing
    Set obj = Nothing
 
End Sub