Anführungszeichen aus Absendernamen löschen

Apostroph aus Empfängeradressen löschen

Je nachdem, wie Adressen an Outlook übergeben werden, sind diese manchmal in Hochkommata eingeschlossen, und die Email kann dann ggf. nicht versendet werden. Dieses Makro löscht solche Adressen aus der Empfängerliste und fügt die bereinigt wieder hinzu. Das Makro wird von Outlook automatisch beim Senden aufgerufen.

  So fügen Sie Makros in Outlook ein

Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
  Dim Recips As Outlook.Recipients
  Dim R As Outlook.Recipient
  Dim Typ As Outlook.OlMailRecipientType
  Dim i As Long
  Dim ReplaceThis As String, ReplaceBy As String
  
  ReplaceThis = Chr(39)
  ReplaceBy = ""
  
  Set Recips = Item.Recipients
  For i = Recips.Count To 1 Step -1
    Set R = Recips(i)
    If InStr(R.Address, ReplaceThis) Then
      Typ = R.Type
      Recips.Remove i
      Set R = Recips.Add(Replace(R.Address, ReplaceThis, ReplaceBy))
      R.Type = Typ
      R.Resolve
    End If
  Next
End Sub

Anführungszeichen aus Absenderadressen löschen

Manchmal zeigt Outlook den Absendernamen einer Email in Anführungszeichen und manchmal nicht. Beim Gruppieren nach Absendern führt das dazu, dass zwei verschiedene Gruppen angezeigt werden, obwohl es sich um den gleichen Absender handelt.

Das folgende Script löscht diese Anführungszeichen. Kopieren Sie den Code ins Modul 'DieseOutlookSitzung'. Markieren Sie die zu bearbeitenden Emails im Ordner und rufen Sie das Script dann einfach mit Alt+F8 auf.

(Das Script funktioniert erst ab Outlook 2007.)

Public Sub EditSenderNames()
  Dim Sel As Outlook.Selection
  Dim Item As Object
  Dim i&
  Dim ReplaceThis$, ReplaceBy$, PropertyName$
  Dim OldValue$, NewValue$

  ReplaceThis = Chr(34)
  ReplaceBy = ""

  'Sendername
  PropertyName = "http://schemas.microsoft.com/mapi/proptag/0x0042001F"

  Set Sel = Application.ActiveExplorer.Selection
  For i = 1 To Sel.Count
    Set Item = Sel(i)
    OldValue = Item.PropertyAccessor.GetProperty(PropertyName)
    NewValue = Replace(OldValue, ReplaceThis, ReplaceBy)
    If OldValue <> NewValue Then
      Item.PropertyAccessor.SetProperty PropertyName, NewValue
      Item.Save
    End If
  Next
End Sub