Envoyer un textRTF par email et garder le formatage [Résolu]

Messages postés
4
Date d'inscription
mardi 5 juin 2012
Statut
Membre
Dernière intervention
14 juin 2012
- - Dernière réponse : TM_
Messages postés
3
Date d'inscription
mardi 24 février 2004
Statut
Membre
Dernière intervention
27 juillet 2012
- 27 juil. 2012 à 12:28
Bonjour à tous !
J'ai recement développé une application qui envoie des mails SMTP via gmail.
Mon problème est que j'utilise une richTextBox, et que mon application gère le gras, souligné, italique, taille et type de police.
Malheuresement, quand j'envoie le mail, j'obtient un petit charabia, sans la bonne mise en forme.

Comment faire ? voici mon code :

Option Explicit

Dim brouillon As String
Dim police As String
Dim taille As Integer
Dim i As Long



'changer la police
Private Sub CmbPolice_Click()

police = CmbPolice.Text
txtCorps.SelFontName = police


txtCorps.SetFocus
End Sub

'changer la taille
Private Sub CmbTaille_Click()

taille = CmbTaille.Text
txtCorps.SelFontSize = taille

txtCorps.SetFocus
End Sub

'Enregistre le brouillon
Private Sub cmdAfficher_Click()
txtCorps.TextRTF = brouillon
MsgBox "Message sauvegardé récupéré !"

txtCorps.SetFocus

End Sub

Private Sub CmdCarnet_Click()

FrmCarnet.Show

End Sub


'Mettre en gras
Private Sub CmdGras_Click()


If txtCorps.SelBold = False Then
    txtCorps.SelBold = True
    CmdGras.BackColor = ColorConstants.vbWhite
Else
    txtCorps.SelBold = False
    CmdGras.BackColor = &H80000002

End If

txtCorps.SetFocus

End Sub


'mettre en Italique
Private Sub CmdItalique_Click()


If txtCorps.SelItalic = False Then
    txtCorps.SelItalic = True
    CmdItalique.BackColor = ColorConstants.vbWhite
Else
    txtCorps.SelItalic = False
    CmdItalique.BackColor = &H80000002

End If

txtCorps.SetFocus
End Sub

Private Sub CmdSouligne_Click()
'Mettre en gras
If txtCorps.SelUnderline = False Then
    txtCorps.SelUnderline = True
    CmdSouligne.BackColor = ColorConstants.vbWhite
Else
    txtCorps.SelUnderline = False
    CmdSouligne.BackColor = &H80000002

End If

txtCorps.SetFocus
End Sub

Private Sub CmdJoindre_Click()
'FrmExplorateur.Show


End Sub

'bouton de reset
Private Sub CmdReset_Click()

txtLogin.Text = ""
txtA.Text = ""
txtCorps.Text = ""
txtObjet.Text = ""

End Sub

'quitter
Private Sub CmdExit_Click()

End

End Sub

'Sauvegarde du brouillon
Private Sub cmdSauvegarder_Click()

If txtCorps = "" Then
    MsgBox "Il n'y a rien à sauvegarder !"
Else
    brouillon = txtCorps.TextRTF
    MsgBox "Message sauvegardé !"

End If

End Sub



'bouton de test
Private Sub CmdTest_Click()

txtLogin.Text = "blabla@gmail.com"
txtA.Text = "blabla@gmail.com"
txtCorps.Text = "Bonjour, voici un mail de test !"
txtObjet.Text = "Mail de test"

End Sub

'Envoyer le message
Private Sub CmdEnvoyer_Click()

Dim oCDO
 
Set oCDO = CreateObject("CDO.Message")
With oCDO
   With .Configuration.Fields ' Configuration "du compte mail SMTP"
     .Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
     .Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.gmail.com"
     .Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = "465"
     .Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = "true"
 
     'Authentification
     .Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = "1"
     .Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = txtLogin
     .Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = txtPassword
     '----------------
     .Update
    End With
  .From = txtLogin.Text
  .To = txtA.Text
  '.Cc = CcAddress 'je n'utilise pas cc pour l'instant
  .Subject = txtObjet.Text
  .TextBody = txtCorps.TextRTF
  .AddAttachment ("D:\Logo.jpg")
  MsgBox "Le message a été envoyé !"
  .Send
End With
 
End Sub

Private Sub Form_Load()

'Types de polices

CmbPolice.AddItem "Arial"
CmbPolice.AddItem "Calibri"
CmbPolice.AddItem "Comic Sans MS"
CmbPolice.AddItem "Courier New"



'Taille de la police
    For i = 8 To 15 Step 1
        CmbTaille.AddItem i
    Next i


'bouton gras, italique et souligné
txtCorps.SelBold = False
txtCorps.SelItalic = False
txtCorps.SelUnderline = False




End Sub

Afficher la suite 

Votre réponse

3 réponses

Meilleure réponse
Messages postés
4
Date d'inscription
mardi 5 juin 2012
Statut
Membre
Dernière intervention
14 juin 2012
3
Merci
J'ai trouvé !

J'ai utilisé un module pour passer du RTF au html.

J'ai ensuite remplacer cette commande

 .TextBody = txtCorps.TextRTF


par

.HTMLBody = ConvertToHTML(txtCorps)

Dire « Merci » 3

Quelques mots de remerciements seront grandement appréciés. Ajouter un commentaire

Codes Sources 152 internautes nous ont dit merci ce mois-ci

Commenter la réponse de cs_blinkme
0
Merci
Bonjour,

L'Alma mater dit que cela prend une passe spéciale pour envoyer du RTF parce que CDO ne supporte pas RTF par défaut.

Là.
Commenter la réponse de Utilisateur anonyme
Messages postés
3
Date d'inscription
mardi 24 février 2004
Statut
Membre
Dernière intervention
27 juillet 2012
0
Merci
Bonjour,

Ou peut on trouver ce module et comment s'appelle t'il ?

Merci
Commenter la réponse de TM_