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

  • Initiateur de la discussion Initiateur de la discussion YohanSC
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

YohanSC

XLDnaute Nouveau
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
 
Solution
Bonjour,
Bonjour,

Proposition :

VB:
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...
Bonjour Yohan, le forum

En ajoutant une condition pour tester la colonne G + ligne
VB:
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
 
Dernière édition:
Bonjour,
Bonjour,

Proposition :

VB:
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
 
Dernière édition:
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

Réponses
4
Affichages
363
Réponses
2
Affichages
719
  • Question Question
Microsoft 365 Code VBA
Réponses
7
Affichages
639
Réponses
2
Affichages
923
  • Question Question
Microsoft 365 Question code VBA
Réponses
2
Affichages
387
Retour