Aide pour intégrer Boucle FOR dans un Mail Outlook - VBA

Bonjour à tous,

J'aurai besoin d'un petit coup de pouce pour une macro.

J'aimerais envoyer un mail qui reprend des infos d'un tableau.

Tout ce passe bien dans le déroulement de la macro et le mail s'écrit quasi correctement.

Le problème est que je suis amené à mettre plusieurs personnes dans le même mail (pour préciser qui a fait quel temps de préparation et de réunion).

J'ai testé cette boucle avec un événement à 2 personnes mais lorsqu'elle s’exécute, seulement la 2ème personne figure dans le mail et je n'arrive pas à comprendre où je dois placer la boucle.

Pouvez-vous m'aider ?

Voici mon code :

Private Sub CommandButton5_Click()
Dim j As Integer, i As Integer
Dim Titre As String, Dat As Date, Lieu As Integer, Exp As String, Prep As Integer, Reu As Integer, lig As Integer
Dim outapp As Object, outmail As Object

lig = ActiveCell.Row

If Not IsEmpty(Cells(lig + 1, 5)) Then
    Titre = Cells(lig, 3)
    Dat = Cells(lig, 1)
    i = Cells(lig, 5)

        Set outapp = CreateObject("Outlook.Application")
        Set outmail = outapp.CreateItem(0)
        With outmail
            For j = 1 To i
                Exp = Cells(lig + j, 3)
                Prep = Cells(lig + j, 15)
                Reu = Cells(lig + j, 16)
            .To = ("xxx.xxx@xxx.com")
            .Subject = "PSR - " & Sheets("ACTIVITÉ 2017").Cells(lig, 3) & " du " & Sheets("ACTIVITÉ 2017").Cells(lig, 1)
            .Body = "Bonjour," & vbCrLf & vbCrLf & "_________________________________ :" & vbCrLf & "Titre de l'événement : " & Sheets("ACTIVITÉ 2017").Cells(lig, 3) & vbCr & "Date de l'événement : " & Sheets("ACTIVITÉ 2017").Cells(lig, 1) & vbCrLf & vbCrLf & "Les personnes concernées par cet événement sont : " & vbCrLf & vbCrLf & "Mr " & Sheets("ACTIVITÉ 2017").Cells(lig + j, 5) & " : " & Sheets("ACTIVITÉ 2017").Cells(lig + j, 15) & " heures de préparation + " & Sheets("ACTIVITÉ 2017").Cells(lig + j, 16) & " heures de réunion"
             Next j
            .Display
            .Send

        End With
        Set outapp = Nothing

End If
End Sub

Bonjour,

l'envoie du mail est effectif à la commande 'SEND'.

déplacer le 'next j' sous le Send :

            .Display
            .Send
             Next j

Bonsoir,

J'avais testé cette solution mais dans ce cas ça envoie autant de mail qu'il y a de participants.

Ce que j'aimerais faire c'est un seul mail où tous les participants et leur temps (prépa + réunion) sont écris à la suite. Mais pour ça je ne sais pas où placer la boucle.

Bonjour,

Dans ce cas, un seul Mail pour tout le monde, mettre la boucle à l'extérieur :

For j = 1 To i
     varDestinataire  = varDestinataire & ";" cells ( j, colonne)
     'faire de même pour l'objet, le message, etc...
next j

        Set outapp = CreateObject("Outlook.Application")
        Set outmail = outapp.CreateItem(0)
        With outmail
                'votre code
            .To = varDestinataire 
                'votre code
            .Display
            .Send

Puis lancer la procédure de votre mail.

En utilisant la bibliothèque CDO, le séparateur (;) est utilisé pour séparer les adresses mails des destinataires, je ne suis pas certain qu'il en soit le même en utilisant Outloock.

Bonjour à tous,

Je vous mets en copie mon code fonctionnel. Je me suis inspiré des aides précédentes .

Private Sub CommandButton5_Click()
Dim j As Integer, i As Integer
Dim Titre As String, Dat As Date, Lieu As Integer, lig As Integer
Dim outapp As Object, outmail As Object

lig = ActiveCell.Row

If Not IsEmpty(Cells(lig, 5)) Then
    Titre = Cells(lig, 3) 'récupère le titre de l'événement
    Dat = Cells(lig, 1) 'récupère la date de l'événement
    introBody = "Bonjour," & vbCrLf & vbCrLf & "Nous vous confirmons que le (ou les) participants(s) suivant(s) ont bien réalisé leur mission dans le cadre de la prestation suivante :" & vbCrLf & "Titre de l'événement : " & Sheets("ACTIVITÉ 2017").Cells(lig, 3) & vbCr & "Date de l'événement : " & Sheets("ACTIVITÉ 2017").Cells(lig, 1) & vbCrLf & vbCrLf & vbCrLf & "Les participants concernés par cet événement sont : " & vbCrLf & vbCrLf

    i = Cells(lig, 5).Value '= au nombre de participant(s) pour cet réunion

    For j = 1 To i
                txt = "Mr " & Sheets("ACTIVITÉ 2017").Cells(lig + j, 5) & " : " & Sheets("ACTIVITÉ 2017").Cells(lig + j, 15) & " heures de préparation + " & Sheets("ACTIVITÉ 2017").Cells(lig + j, 16) & " heures de réunion"
                varBody = txt + vbCrLf & vbCrLf + varBody
    Next

        Set outapp = CreateObject("Outlook.Application")
        Set outmail = outapp.CreateItem(0)
        With outmail
            .To = ("xx.xxxx@xxx.com")
            .CC = ("xx.xxxx@xxx.com")
            .Subject = "PSR - " & Sheets("ACTIVITÉ 2017").Cells(lig, 3) & " du " & Sheets("ACTIVITÉ 2017").Cells(lig, 1)
            .Body = introBody & varBody & vbCr & "Nous vous remercions de bien vouloir procéder au paiement." & vbCrLf & vbCrLf & "Cordialement."
            .Display

        End With
        Set outapp = Nothing

    Cells(lig, 12) = Now() 'place la date de l'envoi dans une case adéquate

End If
End Sub