Mehrzeilige Adressdaten kopieren

Adressen werden fast immer in einem mehrzeiligen Format aufgeschrieben. Wenn Sie so eine Adresse in ein Feld einfügen möchten, das nur eine einzelne Zeile akzeptiert, dann müßten Sie die Adresse zuerst von Hand ändern. Das Feld 'Ort' im Terminformular von Outlook ist so ein Feld, das keine mehrzeiligen Daten akzeptiert.

Dieses Makro kopiert den ausgewählten Text, z.B. aus einer Email, und ersetzt alle Zeilenumbrüche durch das Komma. Dann wird der Text in die Zwischenablage eingefügt. Den Text können Sie jetzt, wie üblich, z.B. mit STRG+V in beliebige Felder einfügen.

Zum Kopieren in die Zwischenablage wird das DataObject aus der MSForms-Bibliothek verwendet. Um die Bibliothek einzubinden, klicken Sie im VBA-Editor auf Einfügen/UserForm. (Sie können das Formular gleich wieder entfernen, das Sie im Projektexplorer sehen.) Beachten Sie auch, dass dieses Makro Outlook 2007 oder neuer erfordert. Sie können es auch mit Outlook 2003 nutzen, wenn Word als Email-Editor verwendet wird; dann ist das Kopieren allerdings nur aus Emails möglich.

Markieren Sie beliebigen Text im Nachrichtenfeld eines Outlook-Elements und drücken Sie dann ALT+F8 zum Starten des Makros.

  So fügen Sie Makros in Outlook ein

Public Sub CopyAsSingleLine()
  Dim Text As String
  Dim DataObject As MSForms.DataObject
  
  Text = GetSelectedText
  
  If Len(Text) Then
    'Zeilenumbrüche durch Komma ersetzen
    Text = Replace(Text, vbCrLf, ",")
    Text = Replace(Text, vbCr, ",")
    Text = Replace(Text, Chr(11), ",")
    
    'Doppelte Komma entfernen
    While InStr(Text, ",,")
      Text = Replace(Text, ",,", ",")
    Wend
    
    'Letztes Komma löschen
    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