[OL-2003] Modifier Option par Macro

[ninoulinou]

Bonjour.

J’ai besoin de votre aide.

J’utilise une macro dans excel 2003 pour envoyer un mail.

Par macro j’y insère du texte et ma signature.

Tout fonctionne si je décoche dans les options puis format du courrier de outlook 2003 « utiliser microsoft office word 2003 pour modifier des messages électroniques ».

Par contre si je laisse cette option coché, le mail que je crée par ma macro excel affiche dans le corps du mail que la signature.

Cette option je souhaite la garder coché.

Y a-t-il une astuce pour décocher cette option lorsque j’utilise ma macro et à la fin de ma macro cocher cette option ?

Voici mon code :

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
Public Sub EnvoiMailMicrosoftOutlook(Destinataire As String, DestinataireCopie As String, Objet As String, TexteMessage As String, FichierJoint As String)
 
'* Initialisation :
Dim MonOutlook As Outlook.Application
Dim MonMessage As Outlook.MailItem
Set MonOutlook = CreateObject("Outlook.Application")
Set MonMessage = MonOutlook.CreateItem(olMailItem)
 
'* Préparation du message :
With MonMessage
    .To = Destinataire
    .CC = DestinataireCopie
    .BCC = ""
    .Subject = Objet
    .HTMLBody = TexteMessage
    .Display '* Affiche le message
End With
 
If FichierJoint = "" Then GoTo suite
MonMessage.Attachments.Add FichierJoint

suite:

Code :

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
44
45
46
47
48
49
50
51
'* Fermeture de la session Outlook :
Set MonOutlook = Nothing
 
End Sub
 
Sub Envoie_mail()
 
'* Déclaration des variables
Dim dest As String
Dim destcopie As String
Dim Obj As String
Dim texte As String
Dim Sign As String
Dim Sig As String
Dim Fich_joint As String
 
'* Destinataire du mail
dest = Sheets("Email").Range("B1")
destcopie = Sheets("Email").Range("B2")
'* Objet du mail
Obj = NomFichier_PDF
'* Texte du mail
texte = "Bonjour <BR><BR>"
texte = texte & "Ci-joint en pièce-jointe le fichier du mois de <FONT COLOR=royalblue>" & ActiveSheet.Name & "</FONT><BR><BR>"
texte = texte & "Cordialement. <BR><BR>"
 
'* Signature du mail
nom = Application.UserName
Sig = "C:\Documents and Settings\" & nom & "\Application Data\Microsoft\Signatures\maSignature.htm"
If Dir(Sig) <> "" Then
    Sign = GetBoiler(Sig)
Else
    Sign = ""
End If
 
texte = texte & Sign
 
'* fichier à joindre
Fich_joint = Chemin_PDF & "\" & NomFichier_PDF & ".pdf"
 
Call EnvoiMailMicrosoftOutlook(dest, destcopie, Obj, texte, Fich_joint)
 
End Sub
Function GetBoiler(ByVal sFile As String) As String
    Dim fso As Object
    Dim ts As Object
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set ts = fso.GetFile(sFile).OpenAsTextStream(1, -2)
    GetBoiler = ts.readall
    ts.Close
End Function