Bonjour,
Ce problème de transformation des accentués en ? ne doit à priori apparaitre
que sur les téléphones portables et, chose étrange, n'apparaissent plus
quand j'associe un fichier joint.
Encore un truc mystère de l'informatique. Une explication?
Sub CDO_Mail_Small_Text()
Dim iMsg As Object
Dim iConf As Object
Dim Strbody As String, strbody2$
Dim C As Range
Dim FichiersJoints As String, Fichier$, FichierList$
On Error Resume Next
Set iConf = CreateObject("CDO.Configuration")
iConf.Load -1 ' CDO Source Defaults
Set Flds = iConf.Fields
With Flds
.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") =
2
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") =
"smtp.orange.fr"
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport")
= 25
' .Item("urn:schemas:mailheader:disposition-notification-to")
= "ponsinet.frederic363@orange.fr"
' .Item("urn:schemas:mailheader:return-receipt-to") =
"ponsinet.frederic363@orange.fr"
.Update
End With
'§§§§§§§§§§ D Formation du texte
For i = 5 To [c1000].End(3).Row
Strbody = Strbody & Cells(i, 3) & vbNewLine
Next
'§§§§§§§§§§ F Formation du texte
Set PlgAdr = Range("A4:" & [B50000].End(3).Address)
PlgAdr.Replace ",", "."
For Each C In Range("B4", Cells(Rows.Count, 2).End(xlUp))
strbody2 = Cells(4, 3) & vbNewLine & vbNewLine & Strbody
Set iMsg = CreateObject("CDO.Message")
With iMsg
Set .Configuration = iConf
.To = C.Value
.CC = ""
.BCC = ""
.From = Exp
Err.Clear
Range("D3:E10").Replace ",", "."
' §§§ fichiers joints
For i = 1 To Application.CountA(Range("D3:D10"))
If Range("D3:D10")(i) <> "" Then
Fichier = Range("E3:E10")(i)
If Right(Range("D3:D10")(i), 1) <> "\" And
Right(Range("D3:D10")(i), 1) <> "/" Then
Range("D3:D10")(i) = Range("D3:D10")(i) & "\"
End If
FichiersJoints = Range("D3:D10")(i) & Fichier
If Dir(Fichier) = "" Then
' MsgBox "ficher " &
Fichier & " sans adresse"
End If
.AddAttachment FichiersJoints
If InStr(FichierList, Fichier) = 0 Then
FichierList = FichierList & Fichier & Chr(10)
' Stop
End If
End If
Next i
If FichierList <> "" Then
FichierList = Left(FichierList, Len(FichierList) - 1)
End If
'demande de confirmation de lecture
'
.Fields("urn:schemas:mailheader:return-receipt-to") =
"ponsinet.frederic363@orange.fr"
'
.Fields("urn:schemas:mailheader:disposition-notification-to") =
"ponsinet.frederic363@orange.fr"
.Subject = Suj
.TextBody = strbody2
.Send
x = x + 1
If Err.Number <> 0 Then
Cells(C.Row, 2).Font.ColorIndex = 9
Err.Clear
x = x - 1
Else
Cells(C.Row, 2).Font.Color = 12611584
End If
End With
Else
C.Font.ColorIndex = 4
End If
Next C
Set Flds = Nothing
Set iMsg = Nothing
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub
Cette action est irreversible, confirmez la suppression du commentaire ?
Signaler le commentaire
Veuillez sélectionner un problème
Nudité
Violence
Harcèlement
Fraude
Vente illégale
Discours haineux
Terrorisme
Autre
Michd
Bonjour, C'est une question de oonfiguration. Ajoute quelques lignes de code, et tu ne devrais plus avoir de problème... Dans ta procédure, ajoute ces lignes de code : Exemple '---------------------------------------------------------------------- Set ObjMail = CreateObject("CDO.Message") With ObjMail .To = Destinataire ' "" .From = Expediteur .CC = AutresDestinataires .Subject = Sujet 'Ajoute ceci à to code '************************** .MimeFormatted = True .GetStream.Charset = cdoISO_8859_15 .BodyPart.Charset = cdoISO_8859_15 .BodyPart.ContentTransferEncoding = "base64" '************************** .TextBody = Texte If Dir(Fichier) <> "" Then .AddAttachment FichiersJoints End If '.../.... '************************** MichD
Bonjour,
C'est une question de oonfiguration.
Ajoute quelques lignes de code, et tu ne devrais plus avoir de problème...
Dans ta procédure, ajoute ces lignes de code : Exemple
'----------------------------------------------------------------------
Set ObjMail = CreateObject("CDO.Message")
With ObjMail
.To = Destinataire ' "Destinataire@Hotmail.com"
.From = Expediteur
.CC = AutresDestinataires
.Subject = Sujet
'Ajoute ceci à to code
'**************************
.MimeFormatted = True
.GetStream.Charset = cdoISO_8859_15
.BodyPart.Charset = cdoISO_8859_15
.BodyPart.ContentTransferEncoding = "base64"
'**************************
.TextBody = Texte
If Dir(Fichier) <> "" Then
.AddAttachment FichiersJoints
End If
'.../....
'**************************
Bonjour, C'est une question de oonfiguration. Ajoute quelques lignes de code, et tu ne devrais plus avoir de problème... Dans ta procédure, ajoute ces lignes de code : Exemple '---------------------------------------------------------------------- Set ObjMail = CreateObject("CDO.Message") With ObjMail .To = Destinataire ' "" .From = Expediteur .CC = AutresDestinataires .Subject = Sujet 'Ajoute ceci à to code '************************** .MimeFormatted = True .GetStream.Charset = cdoISO_8859_15 .BodyPart.Charset = cdoISO_8859_15 .BodyPart.ContentTransferEncoding = "base64" '************************** .TextBody = Texte If Dir(Fichier) <> "" Then .AddAttachment FichiersJoints End If '.../.... '************************** MichD
Fredo P.
Formidable, mais ou vas tu à la pêche?? "Michd" a écrit dans le message de groupe de discussion : pdu6gk$1q3j$ Bonjour, C'est une question de oonfiguration. Ajoute quelques lignes de code, et tu ne devrais plus avoir de problème... Dans ta procédure, ajoute ces lignes de code : Exemple '---------------------------------------------------------------------- Set ObjMail = CreateObject("CDO.Message") With ObjMail .To = Destinataire ' "" .From = Expediteur .CC = AutresDestinataires .Subject = Sujet 'Ajoute ceci à to code '************************** .MimeFormatted = True .GetStream.Charset = cdoISO_8859_15 .BodyPart.Charset = cdoISO_8859_15 .BodyPart.ContentTransferEncoding = "base64" '************************** .TextBody = Texte If Dir(Fichier) <> "" Then .AddAttachment FichiersJoints End If '.../.... '************************** MichD
Formidable, mais ou vas tu à la pêche??
"Michd" a écrit dans le message de groupe de discussion :
pdu6gk$1q3j$1@gioia.aioe.org...
Bonjour,
C'est une question de oonfiguration.
Ajoute quelques lignes de code, et tu ne devrais plus avoir de problème...
Dans ta procédure, ajoute ces lignes de code : Exemple
'----------------------------------------------------------------------
Set ObjMail = CreateObject("CDO.Message")
With ObjMail
.To = Destinataire ' "Destinataire@Hotmail.com"
.From = Expediteur
.CC = AutresDestinataires
.Subject = Sujet
'Ajoute ceci à to code
'**************************
.MimeFormatted = True
.GetStream.Charset = cdoISO_8859_15
.BodyPart.Charset = cdoISO_8859_15
.BodyPart.ContentTransferEncoding = "base64"
'**************************
.TextBody = Texte
If Dir(Fichier) <> "" Then
.AddAttachment FichiersJoints
End If
'.../....
'**************************
Formidable, mais ou vas tu à la pêche?? "Michd" a écrit dans le message de groupe de discussion : pdu6gk$1q3j$ Bonjour, C'est une question de oonfiguration. Ajoute quelques lignes de code, et tu ne devrais plus avoir de problème... Dans ta procédure, ajoute ces lignes de code : Exemple '---------------------------------------------------------------------- Set ObjMail = CreateObject("CDO.Message") With ObjMail .To = Destinataire ' "" .From = Expediteur .CC = AutresDestinataires .Subject = Sujet 'Ajoute ceci à to code '************************** .MimeFormatted = True .GetStream.Charset = cdoISO_8859_15 .BodyPart.Charset = cdoISO_8859_15 .BodyPart.ContentTransferEncoding = "base64" '************************** .TextBody = Texte If Dir(Fichier) <> "" Then .AddAttachment FichiersJoints End If '.../.... '************************** MichD