Discussion :

[Superpat9999]

Bonjour,
Lorsque je reçois certains mails sous Outlook 2013, les caractères accentués sont remplacés par des losanges noirs avec des points d'interrogation au milieu.
Une fois le mail ouvert, je clique sur "Actions" "Autres actions" "Codage", je change le code qui était "Unicode(UFT-8)" en "Unicode(UFT-7)"; puis je refais la même chose en le remettant sur "Unicode(UFT-8)".
Ainsi les caractères peuvent être lus correctement.
Je ne sais pas programmer sous VBA, quelqu'un aurait-il la gentillesse de me faire le code de la manipulation.
Merci d'avance

[carden752]

Bonjour,

il faut utiliser la propriété internetcodepage
Voici un exemple qui permet de modifier le codage en UTF-7 puis UTF-8 pour le mail ouvert.
Attention, il n'y a pas de contrôle sur le fait que ce soit un mail ouvert par exemple ni sur le codage initial
Tu peux le parcourir pour voir l'évolution en pas à pas notamment après avoir sauvegardé la première fois. Il faudra rouvrir le mail ou le visualiser à nouveau depuis l'explorateur de messages pour voir la différence.

Code :

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

1
2
3
4
5
6
7
8
9
10
Sub modifcodage()
Dim m As MailItem
Set m = ActiveInspector.CurrentItem
'65000 = Unicode UTF-7
m.InternetCodepage = 65000
m.Save
'65001 = Unicode UTF-8
m.InternetCodepage = 65001
m.Save
End Sub

[Superpat9999]

Merci carden752,
Je n'arrive pas à modifier l'unicode.
J'ouvre mon mail, lance la macro au pas à pas et rien ne se passe, l'Unicode 7 ne passe pas.
Si je lance la macro complète rien ne se passe, même en refermant et rouvrant mon mail.
Cordialement

[Superpat9999]

Bonjour,
J'ai vérifié que tout fonctionne grâce à cette macro :

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
35
36
37
38
39
40
41
42
43
 Sub Parcourir_Email_Ouverts()
'---------------------------------------------------------------------------------------
' Procedure : Parcourir_Email_Ouverts
' Author    : oliv
' Date      : 09/07/2015
' Purpose   :
'---------------------------------------------------------------------------------------
'
'    Dim m As MailItem
    Dim myInspectors As Outlook.Inspectors
    Dim x As Integer
    Dim iCount As Integer
    Dim MyEmail As Outlook.MailItem
' MsgBox System.Text.Encoding
    Set myInspectors = Application.Inspectors
    iCount = Application.Inspectors.Count
    If iCount > 0 Then
        For x = 1 To iCount
            If myInspectors.Item(x).CurrentItem.Class = olMail Then
                MsgBox myInspectors.Item(x).Caption
                'ICI ON FAIT QUELQUE CHOSE AVEC LE MAIL
                Set MyEmail = myInspectors.Item(x).CurrentItem
 
            End If
        Next x
'Set m = ActiveInspector.CurrentItem
'65000 = Unicode UTF-7
MsgBox MyEmail.InternetCodepage
MyEmail.InternetCodepage = 65000
MyEmail.Save
'MyEmail.Close olSave
 
MsgBox MyEmail.InternetCodepage
'65001 = Unicode UTF-8
MyEmail.InternetCodepage = 65001
MyEmail.Save
MsgBox MyEmail.InternetCodepage
'MyEmail.Close olSave
    Else
        MsgBox "No inspector windows are open."
    End If
 
End Sub

Tout se fait effectivement, mais le résultat n'est pas comme avec les touches ?
Bonne journée

[Superpat9999]

Bonjour, je me réponds.
J'ai trouvé une solution qui ne correspond pas à celle des touches, il suffit juste de changer le code en Unicode UTF-7 :

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
 Sub Parcourir_Email_Ouverts()
'---------------------------------------------------------------------------------------
' Procedure : Parcourir_Email_Ouverts
' Author    : oliv
' Date      : 09/07/2015
' Purpose   :
'---------------------------------------------------------------------------------------
'
'    Dim m As MailItem
    Dim myInspectors As Outlook.Inspectors
    Dim x As Integer
    Dim iCount As Integer
    Dim MyEmail As Outlook.MailItem
    Dim objCurrentMessage As Object
' MsgBox System.Text.Encoding
    Set myInspectors = Application.Inspectors
    iCount = Application.Inspectors.Count
    If iCount > 0 Then
        For x = 1 To iCount
            If myInspectors.Item(x).CurrentItem.Class = olMail Then
                'MsgBox myInspectors.Item(x).Caption
                'ICI ON FAIT QUELQUE CHOSE AVEC LE MAIL
                Set MyEmail = myInspectors.Item(x).CurrentItem
             End If
        Next x
If objCurrentMessage Is Nothing Then Set objCurrentMessage = ActiveInspector.CurrentItem
NomExport = objCurrentMessage.Subject & objCurrentMessage.CreationTime
Set m = ActiveInspector.CurrentItem
MyEmail.InternetCodepage = 65000
MyEmail.Close olSave
    Else
        MsgBox "Aucun message ouvert."
    End If
End Sub

Mon nouveau problème, je suis obligé de réouvrir le mail, a-t-on une commande macro pour réouvrir un mail ?
Bonne journée à tous

[Superpat9999]

Je me réponds à moi-même, sans solutionner mon problème

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
35
36
Sub  Parcourir_Email_Ouverts
'---------------------------------------------------------------------------------------
' Procedure : Parcourir_Email_Ouverts
' Author    : oliv
' Date      : 09/07/2015
' Purpose   :
'---------------------------------------------------------------------------------------
'
'    Dim m As MailItem
    Dim myInspectors As Outlook.Inspectors
    Dim x As Integer
    Dim iCount As Integer
    Dim MyEmail As Outlook.MailItem
    Dim objCurrentMessage As Object
' MsgBox System.Text.Encoding
    Set myInspectors = Application.Inspectors
    iCount = Application.Inspectors.Count
    If iCount > 0 Then
        For x = 1 To iCount
            If myInspectors.Item(x).CurrentItem.Class = olMail Then
                'MsgBox myInspectors.Item(x).Caption
                'ICI ON FAIT QUELQUE CHOSE AVEC LE MAIL
                Set MyEmail = myInspectors.Item(x).CurrentItem
             End If
        Next x
    If objCurrentMessage Is Nothing Then Set objCurrentMessage = ActiveInspector.CurrentItem
        'NomExport = objCurrentMessage.Subject & objCurrentMessage.CreationTime
        '65000 = Unicode UTF-7
        MyEmail.InternetCodepage = 65000
        MyEmail.Save
        MyEmail.Close olSave
        'MyEmail.Display
    Else
        MsgBox "Aucun message ouvert."
    End If
End Sub

Le code 'MyEmail.Display (ligne 32) me permet de ré-ouvrir le mail, mais il ne se passe rien, si je ne mets pas cette ligne, le mail se referme et je dois ré-ouvrir manuellement mon mail; et là, miracle, je peux lire les caractères accentués.
D'où vient le problème ?

Merci de me renseigner

[Superpat9999]

Bonjour,
Toujours pas d'idée pour m'éviter un clic
Bonne journée à tous