VBA - Mailling texte variable

Fredox

XLDnaute Occasionnel
Bonjour,

Je tente de faire un publipostage via excel, ce fichier permet de joindre des pièces jointes.
Pour le texte corps de mail, j'aimerais qu'il soit composé du contenu des cellules C10 à C... dernière ligne vide.

Je n'arrive pas à ecrire cette partie de la macro:

VB:
.HTMLBody = "<font style='font-family: Arial ;font-size: 10pt ;font-style: Regular; '>" _

            & Texte0 _

            For j = 11 To Worksheets("Mail").Range("C" & Rows.Count).End(xlUp).Row

            Worksheets("Mail").Range("C" & j) & "<br>" _

            & Next

            & "<br>" _

            & Signature

Quelqu'un aurait une idée ?
Merci
 

Pièces jointes

  • Fichier_Mailling.xlsm
    30.6 KB · Affichages: 10

Hasco

XLDnaute Barbatruc
Repose en paix
Bonjour,

Un peu fouillis cette macro. :)

Pour écrire des macros, il faut commencer par structurer son travail. Qu'est-ce que la macro doit réaliser en premier puis en second etc....

Prendre un papier pour décrire chaque étape.

En général on commence par les déclarations de variable. Ensuite viennent les actions.

Dans la macro suivante, le corps du mail (dans sa part non variable) est construit en dehors de la boucle de construction des objets mail, et les parts variables (noms, prénoms) dans la boucle.
Inutile de reconstruire à chaque itération, ce qui a été construit une première fois.

Idem pour l'objet Outlook.Application, il n'a pas besoin d'être recréé à chaque mail.

N'imbriquez pas à l'intérieur d'un block With (Un objet) ...End With d'autre blocks With (un autre objet)...End With si le second objet n'est pas enfant du premier.

Mauvais exemple :
Code:
With ThisWorkBook
     ' Travail sur le classeur
     '....
      .Sheets("Truc").Name ="Chose"
      '......
     With OutMail ' n'est pas objet enfant de ThisWorkBook
  
     End With
End With

VB:
Sub Mail()

    'Working in Excel 2000-2016
    'For Tips see: http://www.rondebruin.nl/win/winmail/Outlook/tips.htm

    Dim TempFilePath As String, Strbody As String, TempFileName As String
    Dim FileExtStr As String, SigString As String, Signature As String
    Dim FileFormatNum As Long, DL As Long, DLt As Long, j As Long
    Dim Sourcewb As Workbook, destwb As Workbook
    Dim OutApp As Object, OutMail As Object


    If Worksheets("Liste").Range("D3") = "" Then
        Prbemail
        Exit Sub
    End If

    Application.DisplayAlerts = False

    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With

    '---

    Strbody = "Bonjour " & Prenom & ",<br>" _
            & "<br>" _
            & "Cordialement,<br>" _
            & "<br>" _
            & "<br>"


    SigString = Environ("appdata") & _
                "\Microsoft\Signatures\\RD-SAV2.htm"

    If Dir(SigString) <> "" Then Signature = GetBoiler(SigString)

    '---
    DL = Worksheets("Liste").Cells(Rows.Count, 4).End(xlUp).Row
    DLt = Worksheets("Mail").Cells(Rows.Count, 3).End(xlUp).Row

    '
    '---- Construction du corps de mail dans lequel 'Texte0' sera inséré plus tard
    '
    Strbody = "<font style='font-family: Arial ;font-size: 10pt ;font-style: Regular; '>[Texte0]<br>"

    For j = 11 To DLt
        Strbody = Strbody & Worksheets("Mail").Range("C" & j) & "<br>"
    Next

    Strbody = Strbody & "<br>" & Signature
    '
    '--- Initialisation de l'objet Outlook Application
    '
    Set OutApp = CreateObject("Outlook.Application")
    '
    '--- Construction des mails et envois
    '
    For i = 3 To DL
        '
        ' Insertion des parties variable du corps de mail
        '
        If Worksheets("Liste").Range("B" & i) <> "" Then
            Texte0 = "Bonjour " & Worksheets("Liste").Range("A" & i) & " " & Worksheets("Liste").Range("B" & i) & ","
        Else
            Texte0 = "Bonjour " & Worksheets("Liste").Range("C" & i) & ","
        End If
        
        Strbody = Replace(Strbody, "[Texte0]", Texte0)
        '
        ' Création d'un nouveau mail item
        '
        Set OutMail = OutApp.CreateItem(0)

        With OutMail
            .To = Worksheets("Liste").Range("D" & i)
            .Cc = ""
            .BCC = ""
            .Subject = Worksheets("Mail").Range("C2")
            .HTMLBody = Strbody
            '.Attachments.Add sFichier1.FullName
            .display
        End With
        '
        ' nettoyage de la variable objet mail courant
        Set OutMail = Nothing
        '.Close savechanges:=False

    Next
    '
    '--- Nettoyage des variable objet outlook
    '
    Set OutMail = Nothing
    Set OutApp = Nothing

    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With

    Application.DisplayAlerts = True

End Sub

Cordialement
 

Pièces jointes

  • Fichier_Mailling.xlsm
    26.1 KB · Affichages: 8
Dernière édition:

Fredox

XLDnaute Occasionnel
Bonjour Roblochon,

Merci pour ton aide.
C'est vrai que c'était le fouillis, je me concentrais sur le problème du texte avant de régler le reste... mais tu as raison, j'aurais d'abord dû tout bien posé.

Ta solution fonctionne parfaitement, merci.

Du coup, j'ai ajouter les 3 pièces jointes et éviter les erreur si justement il n'y en a pas.
Concernant la signature mail, j'aimerais sélectionné une signature via une boite de dialogue, comment passer d'une signature dont le chemin est écrit en code (comme ci-dessous)
VB:
SigString = Environ("appdata") & _
   "\Microsoft\Signatures\Signature.htm"

A une signature sélectionnée via une boite de dialogue (mais que le répertoire cible soit ouvert à l'avance au bon endroit ?
Code:
    SigString = Application.GetOpenFilename(, , "Sélectionnz une signature mail")
vers: Environ("appdata") & _
"\Microsoft\Signatures\

Merci
 

Discussions similaires

Réponses
10
Affichages
1 K
Réponses
22
Affichages
8 K

Statistiques des forums

Discussions
312 396
Messages
2 088 055
Membres
103 709
dernier inscrit
FrrankX