Outlook hängt beim Lesen von PayPal-E-Mails

Zuletzt geändert am 03. April 2013

Anwender, die E-Mails von PayPal erhalten, haben zum Teil das Problem, dass Outlook® beim Anzeigen dieser E-Mails im Vorschaufenster augenscheinlich einfriert.

In Wirklichkeit versucht Outlook® einen in der E-Mail enthaltenen, fehlerhaften Link aufzulösen.

Dabei verweist der Link auf

//102.112.2O7.net/b/ss/paypalglobal/1/G.4--NS/123456?pageName=system_email_PP753

sollte aber richtig

https://102.112.2O7.net/b/ss/paypalglobal/1/G.4--NS/123456?pageName=system_email_PP753

lauten. Der Link befindet sich fast ganz am Ende des HTML-Quelltextes.

Mit dem hier vorgestellten Code lässt sich der fehlerhafte Link korrigieren und damit das Problem beheben.

Zur Verwendung dieses Beispiels beachten Sie bitte die wichtigen Hinweise, sowie den Workshop VBA in Outlook® verwenden.

Ab Outlook® 2000

Den Code bitte in ein neues Modul kopieren (Einfügen -> Modul im VBA-Editor):

Option Explicit
 
Public Sub RepairPayPalEmails()
 
    '=====================================================================
    ' Repariert defekte PayPal-E-Mails im aktuellen Ordner
    ' (c) Peter Marchert - http://www.outlook-stuff.com/
    ' 2011-10-14 - Version 1.0.0
    '=====================================================================
 
    Dim objItems As Outlook.Items
    Dim objItem As Outlook.MailItem
 
    Const ADDRESS As String = "//102.112.2O7"
 
    Dim lngRepaired As Long
 
    On Error Resume Next
 
    '---------------------------------------------------------------------
    ' Alle Elemente im aktuellen Ordner referenzieren
    '---------------------------------------------------------------------
    Set objItems = Outlook.ActiveExplorer.CurrentFolder.Items
 
    '---------------------------------------------------------------------
    ' Alle Elemente bearbeiten
    '---------------------------------------------------------------------
    For Each objItem In objItems
 
        '-----------------------------------------------------------------
        ' Enhält die E-Mail die defekte Adresse?
        '-----------------------------------------------------------------
        If InStr(objItem.HTMLBody, """" & ADDRESS) Then
 
            '-------------------------------------------------------------
            ' Fehlendes "https:" davor setzen
            '-------------------------------------------------------------
            objItem.HTMLBody = Replace(objItem.HTMLBody, ADDRESS, "https:" & ADDRESS)
 
            '-------------------------------------------------------------
            ' Änderung speichern
            '-------------------------------------------------------------
            objItem.Save
 
            '-------------------------------------------------------------
            ' Zähler für reparierte E-Mails erhöhen
            '-------------------------------------------------------------
            lngRepaired = lngRepaired + 1
 
        End If
 
    Next
 
    '---------------------------------------------------------------------
    ' Meldung an Benutzer
    '---------------------------------------------------------------------
    MsgBox "Elemente im Ordner: " & objItems.Count & vbCrLf & _
        "Reparierte PayPal-E-Mails: " & lngRepaired, vbInformation, _
        "PayPal-Reparatur"
 
    '---------------------------------------------------------------------
    ' Clean Up
    '---------------------------------------------------------------------
    Set objItem = Nothing
    Set objItems = Nothing
 
End Sub

Damit beheben Sie den Fehler bei bestehenden E-Mails in aktuellen Ordner. Das Makro lässt sich mit ALT+F8 -> Ausführen starten.

Bis PayPal den Fehler behoben hat, können Sie den folgenden Codeteil in das Modul DieseOutlookSitzung kopieren, um auch neu eintreffende E-Mails automatisch zu korrigieren:

Option Explicit
 
    ' "WithEvents" bedeutet, dass diese Variable auf Ereignisse reagiert
    Private WithEvents m_objInboxItems As Outlook.Items
 
Private Sub Application_Startup()
 
    '---------------------------------------------------------------------
    ' Referenz auf alle Elemente im Posteingang setzen
    '---------------------------------------------------------------------
    Set m_objInboxItems = Outlook.Session.GetDefaultFolder(olFolderInbox).Items
 
End Sub
 
Private Sub m_objInboxItems_ItemAdd(ByVal item As Object)
 
    '=====================================================================
    ' Repariert defekte PayPal-E-Mails automatisch beim Eintreffen
    ' (c) Peter Marchert - http://www.outlook-stuff.com/
    ' 2011-10-14 - Version 1.0.0
    '=====================================================================
 
    Const ADDRESS As String = "//102.112.2O7"
 
    On Error Resume Next
 
    If InStr(item.HTMLBody, """" & ADDRESS) Then
        item.HTMLBody = Replace(item.HTMLBody, ADDRESS, "https:" & ADDRESS)
        item.Save
    End If
 
End Sub

Damit dieser Code wirksam wird, muss Outlook® neu gestaret werden.