VBA - Script Outlook se concentrant sur le mauvais email

Voici un script que j'ai rassemblé à partir d'un certain nombre d'autres sources. Il se déclenche chaque fois qu'un nouvel e-mail arrive via une règle d'e-mail dans Microsoft Outlook 2013. Le script DEVRAIT regarder l'e-mail entrant et supprimer l'arrière-plan de la page.VBA - Script Outlook se concentrant sur le mauvais email

Ce qui se passe réellement, c'est que je reçois la petite fenêtre disant que le nouveau message est arrivé, et il supprimera l'arrière-plan de l'e-mail qui était DÉJÀ LA FOCUS dans Outlook! Donc, si je clique sur un e-mail avec un arrière-plan html pour que ce soit le centre de la fenêtre de prévisualisation et que je reçoive un nouveau courriel, cela supprimera l'arrière-plan de ce courriel ... bien ... mais ... Je veux qu'il vérifie le message nouvellement arrivé à la place!

Des idées?

Sub CustomMailMessageRule(Item As Outlook.MailItem) 
    MsgBox "Mail message arrived: " & Item.Subject 
    Call ClearStationeryFormatting 
End Sub 

Sub ClearStationeryFormatting() 
On Error GoTo ClearStationeryFormatting_Error 
    Dim strEmbeddedImageTag As String 
    Dim strStyle As String 
    Dim strReplaceThis As String 
    Dim intX As Integer, intY As Integer 
    Dim myMessage As Outlook.MailItem 

    ' First, check to see if we are in preview-pane mode or message-view mode 
    ' If neither, quit out 
    Select Case TypeName(Outlook.Application.ActiveWindow) 
     Case "Explorer" 
      Set myMessage = ActiveExplorer.Selection.Item(1) 
     Case "Inspector" 
      Set myMessage = ActiveInspector.CurrentItem 
     Case Else 
      MsgBox ("No message selected.") 
      Exit Sub 
    End Select 

    ' Sanity check to make sure selected message is actually a mail item 
    If TypeName(myMessage) <> "MailItem" Then 
     MsgBox ("No message selected.") 
     Exit Sub 
    End If 

    ' Remove attributes from <BODY> tag 
    intX = InStr(1, myMessage.HTMLBody, "<BODY", vbTextCompare) 
    If intX > 0 Then 
     intY = InStr(intX, myMessage.HTMLBody, ">", vbTextCompare) 
     strReplaceThis = Mid(myMessage.HTMLBody, intX, intY - intX + 1) 
    End If 

    If strReplaceThis <> "" Then 
     myMessage.HTMLBody = Replace(myMessage.HTMLBody, strReplaceThis, "<BODY>") 
     strReplaceThis = "" 
    Else 
     Err.Raise vbObjectError + 7, , "An unexpected error occurred searching for the BODY tag in the e-mail message." 
     Exit Sub 
    End If 

    ' Find and replace <STYLE> tag 
    intX = InStr(1, myMessage.HTMLBody, "<STYLE>", vbTextCompare) 
    If intX > 0 Then 
     intY = InStr(8, myMessage.HTMLBody, "</STYLE>", vbTextCompare) 
     strReplaceThis = Mid(myMessage.HTMLBody, intX, ((intY + 8) - intX)) 
    End If 

    If strReplaceThis <> "" Then 
     myMessage.HTMLBody = Replace(myMessage.HTMLBody, strReplaceThis, "") 
    End If 

    If InStr(1, myMessage.HTMLBody, "<center><img id=", vbTextCompare) > 0 Then 
     strEmbeddedImageTag = "<center><img id=" 
     '"<center><img id=""ridImg"" src="citbannA.gif align=bottom></center>" 
     intX = InStr(1, myMessage.HTMLBody, strEmbeddedImageTag, vbTextCompare) 
     If intX = 0 Then 
      Err.Raise vbObjectError + 8, , "An unexpected error occurred searching for the embedded image file name start tag in the e-mail message." 
      Exit Sub 
     End If 
     intY = InStr(intX + Len(strEmbeddedImageTag), myMessage.HTMLBody, " align=bottom></center>", vbTextCompare) 
     If intY = 0 Then 
      Err.Raise vbObjectError + 9, , "An unexpected error occurred searching for the embedded image file name end tag in the e-mail message." 
      Exit Sub 
     End If 
     strEmbeddedImageTag = Mid(myMessage.HTMLBody, intX, intY - intX) 
     intX = InStr(1, myMessage.HTMLBody, "<CENTER>", vbTextCompare) 
     intY = InStr(intX, myMessage.HTMLBody, "</CENTER>", vbTextCompare) 
     strReplaceThis = Mid(myMessage.HTMLBody, intX, intY - intX) & "</CENTER>" 
     myMessage.HTMLBody = Replace(myMessage.HTMLBody, strReplaceThis, "", , , vbTextCompare) 
    End If 

    ' Finally, saved modified message 
    myMessage.Save 

    On Error GoTo 0 
    Exit Sub 

ClearStationeryFormatting_Error: 

    MsgBox "Error " & Err.Number & " (" & Err.Description & ")" 
    Resume Next 
End Sub

Source

2017-05-23 Jack

désolé que le script semble briser et de la mise en forme. – Jack

Vous devriez être en mesure de passer l'article de courrier que vous souhaitez traiter en tant que paramètre, à savoir

Sub CustomMailMessageRule(Item As Outlook.MailItem) 
    MsgBox "Mail message arrived: " & Item.Subject 
    ClearStationeryFormatting Item 
End Sub 

Sub ClearStationeryFormatting(myMessage As Outlook.MailItem) 
    On Error GoTo ClearStationeryFormatting_Error 
    Dim strEmbeddedImageTag As String 
    Dim strStyle As String 
    Dim strReplaceThis As String 
    Dim intX As Integer, intY As Integer 

    ' Remove attributes from <BODY> tag 

    '...

Source

2017-05-23 04:45:43 YowE3K

Merci pour cette réponse rapide et pour avoir reformaté le message original. J'ai fait ce changement exact, mais bizarrement, cela n'a fait aucune différence. – Jack

J'ai enlevé le changement de cas et maintenant cela fonctionne parfaitement! Merci pour votre contribution :-) – Jack

VBA - Script Outlook se concentrant sur le mauvais email

Répondre

Questions connexes