Discussion :

[ubuntu666]

Bonjour,

Je n'ai pas trouvé les mots pour vérifier si le sujet existait déjà.

Mon service IT impose désormais un encadré incorporé en tête du corps de texte de tous les emails reçus par une personne extérieure,
en gras, fond jaune fluo



C'est tout simplement une horreur à la longue, ma boite email ne ressemble plus à rien, pollution et fatigue visuelle, et en plus lorsqu'on répond à son correspondant, il faut supprimer à la main cet encadré car sinon il le reçoit aussi dans l'historique de conversation.

Est-ce que cela vous parait possible avec du VBA de supprimer automatiquement cet encadré ou via un raccourci ?

Je suis novice sur du VBA pour Outlook, confirmé sur du VBA pour Excel

Merci par avance pour vos conseils et suggestions

[Korkal]

Bonjour.

Je te suggère un code qui:
-boucle sur tous les objets mails de ta boîte au lettre
-recherche dans le corps de chaque Item le texte (qui est une constante) et l'élimine

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
On Error GoTo Catch_error
Set objOL = New Outlook.Application
Set objNS = objOL.GetNamespace("MAPI")
 
For Each oAccount In objOL.Session.Accounts
    If oAccount.DisplayName = "ton mail" Then
        Set objFolder = oAccount.DeliveryStore.GetDefaultFolder(olFolderInbox)
 
        For Each myItem In objFolder.Items
 
			'On vérifie que l'object est bien un mail
			On Error GoTo Catch_nomail
			bolMail = True
			Set oMail = objNS.GetItemFromID(strIds(lggItemActual))
			On Error GoTo Catch_error
			If bolMail = true then
				With oMail
                                   HTMLBody = replace(.HTMLBody, strTexteARemplacer,"",1) 
                                   .Save
				End With
			End if
			Set oMail=Nothing
 
		Next
    End If
Next oAccount
 
Exit sub
Catch_nomail:
	bolMail = False
	resume next
Catch_error:
	'Procédure de traitement de l'erreur
	Exit sub

Si la fonction Replace ne marche pas (je n'ai pas testé), tu devras passer par une recherche de la position du texte dans le HTMLBody (Instr).

Bonne chance.

[ubuntu666]

Merci Korkal pour cette réponse.

Où est-ce que je dois insérer le texte à remplacer dans le code ?

Il faut peut être que je me documente un peu à propos de HTMLBody ?

[ubuntu666]

Quand je fais une résolution pas à pas, ça bloque sur le terme strIds ?

[Korkal]

Désolé, j'ai répondu sans doute trop vite.

Je te joins le code rectifié, avec les déclarations de variables.
1. N'oublie pas de déclarer en "références" la librairie MICROSOFT OUTLOOK OBJECT LIBRARY (je travaille avec la 16; code non testé avec d'autres)
2. Remplace "tonmail" par ta dirección email
3. Remplace "tontexteHTML" par le texte que tu veux systématiquement supprimé. Attention ce doit être exactemente le code HTML.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
Dim objOL As Outlook.Application
Dim oAccount As Outlook.Account
Dim objFolder As Outlook.MAPIFolder
Dim myItem As Object

On Error GoTo Catch_error
Set objOL = New Outlook.Application

For Each oAccount In objOL.Session.Accounts
    If oAccount.DisplayName = "tonmail" Then
        Set objFolder = oAccount.DeliveryStore.GetDefaultFolder(olFolderInbox)
        For Each myItem In objFolder.Items
            'On vérifie que l'object est bien un mail
                With myItem
                    On Error GoTo Catch_nomail
                    .HTMLBody = Replace(.HTMLBody, "tontexteHTML", "", 1)
                    .Save
                    On Error GoTo Catch_error
                End With
        Next
    End If
Next oAccount
 
Exit Sub
Catch_nomail:
    Resume Next
Catch_error:
    'Procédure de traitement de l'erreur
    Exit Sub

[Korkal]

Merci de marquer "résolu" si le problème est réglé.