Texte du mail qui ne s'affiche pas entiérement

Bonjour à tous,

Je reviens avec une autre question sur ce code VBA.

Quand j'active la commande, soit une partie de mon corps de mail et manquante juste le "Bonjour" s'affiche, soit j'ai les caractères

%20 et 0D%0A qui s'affiche pouvez-vous me venir en aide ?

Encore un grand merci !

Private Sub CommandButton1_Click()

    Dim ProgThunderbird As String
    Dim cmd As String
    Dim destinataire As String
    Dim copie As String
    Dim sujet As String
    Dim texteBrut As String
    Dim texteEncode As String
    Dim monCourriel As String

    ' Chemin vers Thunderbird — adapte si nécessaire
    ProgThunderbird = """C:\Program Files\Courrielleur Mel\thunderbird.exe"""
    ' Adresse mail dans la cellule A1
    destinataire = Trim(ThisWorkbook.Sheets(1).Range("A1").Value)
    copie = "copie@example.com"
    sujet = "Sujet de l'email"

    If destinataire = "" Then
        MsgBox "La cellule A1 ne contient pas d'adresse email.", vbExclamation
        Exit Sub
    End If

    ' Texte du mail avec retours à la ligne vbCrLf
    texteBrut = "Bonjour," & vbCrLf & _
                "Veuillez trouver ci-joint une attestation de remise de matériel." & vbCrLf & _
                "Merci par avance de bien vouloir nous la retourner signé à" & vbCrLf & _
                "Merci par avance," & vbCrLf & _
                "Bien cordialement."

    ' Encode le texte en URL UTF-8 (espaces en %20, retours ligne en %0D%0A)
    texteEncode = URLEncodeUTF8(texteBrut)

    ' Construction de la commande -compose
    monCourriel = "-compose ""to=" & destinataire & _
                  ",cc=" & copie & _
                  ",subject=" & URLEncodeUTF8(sujet) & _
                  ",body=" & texteEncode & """"

    cmd = ProgThunderbird & " " & monCourriel

    Debug.Print cmd

    ' Exécute la commande pour ouvrir Thunderbird avec le mail prêt
    Shell cmd, vbNormalFocus

End Sub

Public Function URLEncodeUTF8(ByVal Text As String) As String
    Dim i As Long
    Dim CharCode As Integer
    Dim CharUTF8() As Byte
    Dim c As String
    Dim Result As String

    Result = ""
    For i = 1 To Len(Text)
        c = Mid(Text, i, 1)
        CharCode = AscW(c)

        Select Case CharCode
            Case 48 To 57, 65 To 90, 97 To 122 ' 0-9, A-Z, a-z
                Result = Result & c
            Case 32 ' espace
                Result = Result & "%20"
            Case 13 ' CR
                Result = Result & "%0D"
            Case 10 ' LF
                Result = Result & "%0A"
            Case 44, 46, 45, 64 ' , . - @
                Result = Result & c
            Case Else
                CharUTF8 = StrConv(c, vbFromUnicode) ' conversion UTF-8
                Dim j As Long
                For j = LBound(CharUTF8) To UBound(CharUTF8)
                    Result = Result & "%" & Right("0" & Hex(CharUTF8(j)), 2)
                Next j
        End Select
    Next i

    URLEncodeUTF8 = Result
End Function

Bonjour,

Et comme ceci, ça marche?

Public Function URLEncodeUTF8(ByVal Text As String) As String
    Dim i As Long
    Dim CharCode As Integer
    Dim CharUTF8() As Byte
    Dim c As String
    Dim Result As String

    Result = ""
    For i = 1 To Len(Text)
        c = Mid(Text, i, 1)
        CharCode = AscW(c)

        Select Case CharCode
            Case 48 To 57, 65 To 90, 97 To 122 ' 0-9, A-Z, a-z
                Result = Result & c
            Case 32 ' espace
                Result = Result & " "
            Case 13 ' CR
                Result = Result & Chr(10)
            Case 10 ' LF
                Result = Result & Chr(32)
            Case 44, 46, 45, 64 ' , . - @
                Result = Result & c
            Case Else
                CharUTF8 = StrConv(c, vbFromUnicode) ' conversion UTF-8
                Dim j As Long
                For j = LBound(CharUTF8) To UBound(CharUTF8)
                    Result = Result & "%" & Right("0" & Hex(CharUTF8(j)), 2)
                Next j
        End Select
    Next i
    Range("A1").Value = URLEncodeUTF8
    URLEncodeUTF8 = Result
End Function

Cdlt

Rechercher des sujets similaires à "texte mail qui affiche pas entierement"