Transformation des é à ù en?

Le
Fredo P.
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
Vos réponses
Gagnez chaque mois un abonnement Premium avec GNT : Inscrivez-vous !
Trier par : date / pertinence
Michd
Le #26475666
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.
Le #26475791
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
Publicité
Poster une réponse
Anonyme