Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

Code envoi mail

castor30

XLDnaute Occasionnel
Bonjour le forum,
Avec le code joint (je ne peux mettre le fichier) qui fonctionne en apparence, le corps du texte est tronqué. Pourquoi ?
En vous remerciant.
VB:
Sub Envoidu_MailAutomatique2()
    'On Error Resume Next
    ' Touche de raccourci du clavier: Ctrl+e
    Dim OutApp As Object
    Dim OutMail As Object
    Dim strbody As String
    Dim PJ As String        'Piece-Jointe=OUI/NON
    Dim List_To As String, List_Cop As String

    UF_Attente.Show vbModeless

    'ici je repère la dernière ligne vide pour la Collection des données
    List_To = "": List_Cop = ""
    With Worksheets("Mail")
        derlig = Range("N" & Rows.Count).End(xlUp).Row
        If derlig > 2 Then
            For n = 3 To derlig
                List_To = List_To & .Cells(n, "N") & "; "
            Next n
            List_To = Left(List_To, Len(List_To) - 1) & vbTab
        Else
            MsgBox "Attention: pas de destinataire!!!!"
            Exit Sub
        End If
        derlig = Range("O" & Rows.Count).End(xlUp).Row
        If derlig > 2 Then
            For n = 3 To derlig
                List_Cop = List_Cop & .Cells(n, "O") & ";"
            Next n
            List_Cop = Left(List_Cop, Len(List_Cop) - 1) & vbTab
        End If
    End With

    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)
    'contenu Message
    With Worksheets("Mail")
        PJ = .Range("M2")
        Sujet = .Range("J3")
        strbody = .Shapes("CorpsMessage").TextFrame.Characters.Text & vbTab
    
    End With
    With OutMail
        .To = List_To
        .CC = List_Cop
        .BCC = ""
        .Subject = Sujet
        .Body = strbody
        'You can add a file like this
        If UCase(PJ) = "OUI" Then
            .Attachments.Add (Worksheets("Mail").Range("M3").Value)      'mettre ce que vous voulez !!!!!!!!!!!!!!!!!!!!
        End If
        '.Display
        'or use
        .Send
    End With
    'attente envoi @Mail par Outlook
    'Application.Wait Application.Wait(Now + TimeValue("0:00:01"))
    Set OutMail = Nothing
    Set OutApp = Nothing
    Unload UF_Attente
       ' Message de confirmation d'envoi
       MsgBox "Le mail a été envoyer"
End Sub
 

Pièces jointes

  • Classeur mail.xls
    95 KB · Affichages: 23
Dernière édition:
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…