Copy Multiline Addresses

Mailing addresses almost always have a multi-line format. If you want to paste such a text into a field that doesn't accept multi-lines, then you'd have to edit it manually before copying the text. For instance, the 'Location' field of the Outlook appointment form is such a field that doesn't accept multi-lines.

This macro copies the selected text, for instance from an email, and replaces all line breaks by a comma. Then the text is added to the clipboard. Now you can paste the text as usual, for instance by pressing CTRL+V, into any fields.

For copying data to the clipboard the DataObject of the MSForms library is used. In order to add a reference to that library, click in the VBA editor on Insert/UserForm. (You could then remove the form, which you see in the project explorer.). Also note, this macro requires Outlook 2007 or higher. You could also use it with Outlook 2003 if Word is used as email editor, however, in this case only emails are supported.

Select any text in the message field of an Outlook item, then press ALT+F8 in order to start the macro.

  How to add macros to Outlook

Public Sub CopyAsSingleLine()
  Dim Text As String
  Dim DataObject As MSForms.DataObject
  
  Text = GetSelectedText
  
  If Len(Text) Then
    'Replace line breaks by comma
    Text = Replace(Text, vbCrLf, ",")
    Text = Replace(Text, vbCr, ",")
    Text = Replace(Text, Chr(11), ",")
    
    'Remove double comma
    While InStr(Text, ",,")
      Text = Replace(Text, ",,", ",")
    Wend
    
    'Remove the very last comma
    If Right$(Text, 1) = "," Then
      Text = Left$(Text, Len(Text) - 1)
    End If
    
    Set DataObject = New MSForms.DataObject
    DataObject.SetText Text, 1
    DataObject.PutInClipboard
  End If
End Sub

Public Function GetSelectedText() As String
  Dim Sel As Outlook.Selection
  Dim Doc As Object 'Word.Document
  Dim Wd As Object 'Word.Application
  Dim WdSel As Object 'Word.Selection
  
  If TypeOf Application.ActiveWindow Is Outlook.Inspector Then
    Set Doc = Application.ActiveInspector.WordEditor
  Else
    Set Sel = Application.ActiveExplorer.Selection
    If Sel.Count Then
      Set Doc = Sel(1).GetInspector.WordEditor
    End If
  End If
  
  If Not Doc Is Nothing Then
    Set Wd = Doc.Application
    Set WdSel = Wd.Selection
    GetSelectedText = WdSel.Text
  End If
End Function