Outlook hängt beim Lesen von PayPal-E-Mails
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.