XL 2019 Condition pour l'envoi d'e-mail automatisé (VBA)

[YohanSC]

Bonjour à tous,

J'ai un code qui me permet d'envoyer les mdp et les noms d'utilisateur suivant une base de données. (envoi via outlook)

Cependant, je souhaiterais ajouter une condition car dans la colonne G , il se peut qu'il n’y ai pas d'adresse e-mail ( donc ne rien faire et passer à la cellule suivante)

Merci pour votre aide

Voici la macro :
Private Sub CommandButton1_Click()

Dim lemail As Variant
Dim ligne As Integer
For ligne = 1 To 150

Set lemail = CreateObject("Outlook.Application")

With lemail.createItem(olMailItem)

.Subject = "Vos données de connexion"

.To = Range("G" & ligne)

.Body = "Cher(e)s étudiant(e)s," & vbCrLf & vbCrLf & "Veuillez trouver ci-joint votre login ainsi que votre mot de passe" & vbCrLf & "Nom utilisateur : " & Range("D" & ligne) & vbCrLf & "Mot de passe : " & Range("E" & ligne) & vbCrLf & "Voici le lien : " & vbCrLf & vbCrLf & "Cordialement,"

.Send
End With
Next ligne
ActiveWorkbook.Save
End Sub

 

[Phil69970]

Bonjour Yohan, le forum

En ajoutant une condition pour tester la colonne G + ligne

Private Sub CommandButton1_Click()

Dim lemail As Variant
Dim ligne As Integer
For ligne = 1 To 150
    If  IsEmpty(Range("G" & ligne)) = False Then   ' Test si cellule G + Ligne est vide
    Set lemail = CreateObject("Outlook.Application")
        With lemail.createItem(olMailItem)
            .Subject = "Vos données de connexion"
            .To = Range("G" & ligne)
            .Body = "Cher(e)s étudiant(e)s," & vbCrLf & vbCrLf & "Veuillez trouver ci-joint votre login ainsi que votre mot de passe" _
            & vbCrLf & "Nom utilisateur : " & Range("D" & ligne) & vbCrLf & "Mot de passe : " & Range("E" & ligne) & vbCrLf & "Voici le lien : " _
            & vbCrLf & vbCrLf & "Cordialement,"
            .Send
        End With
    End If
Next ligne
ActiveWorkbook.Save
End Sub

*J'ai modifié légèrement le code
@Phil69970

 

[Hasco]

Bonjour,
Bonjour,

Proposition :

Private Sub CommandButton1_Click()

    Dim lemail As Variant
    Dim ligne As Integer

    '
    ' L'objet Outlook.Application n'a pas besoin d'être créé autant de fois que de lignes
    Set lemail = CreateObject("Outlook.Application")
  
    For ligne = 1 To 150

        '
        ' Tester la cellule avant de créer un mail
        ' Si arobase dans cellule alors traiter la ligne
        If InStr(Range("G" & ligne), "@") > 0 Then
            With lemail.createItem(olMailItem)

                .Subject = "Vos données de connexion"

                .To = Range("G" & ligne)

                .Body = "Cher(e)s étudiant(e)s," & vbCrLf & vbCrLf & "Veuillez trouver ci-joint votre login ainsi que votre mot de passe" & vbCrLf & "Nom utilisateur : " & Range("D" & ligne) & vbCrLf & "Mot de passe : " & Range("E" & ligne) & vbCrLf & "Voici le lien : " & vbCrLf & vbCrLf & "Cordialement,"

                .Send
            End With
        End If
    Next ligne
    Set lemail = Nothing ' Destruction de l'objet applicaiton
    ActiveWorkbook.Save
End Sub

Cordialement

 

[YohanSC]

Merci beaucoup ... Ça fonctionne super .