VBA: Comment envoyer directement depuis excel un mail

Messages postés
7
Date d'inscription
vendredi 18 janvier 2019
Statut
Membre
Dernière intervention
14 juin 2019
-
Bonjour,

Je bloque complètement sur un code permettant d'envoyer un mail depuis une feuille excel. Alors je profite de la communauté pour vous envoyer cette demande afin que vous puissiez me guider à travers cette longue traversé du désert :-)

L'objectif:
Idéalement, à partir d'un code VBA, réussir à envoyer une sélection de chacune des feuilles (cellule A1 jusqu'à la dernière ligne renseignée) à chacun des destinataires correspondants.

Voici le premier morceau de code déjà créer:

'Déclaration de variable

Dim OutlookApp As Object
Dim OutlookMail As Object
Dim i As Byte

Sub Email()


For i = 2 To ThisWorkbook.Worksheets("abekkal").Range("D" & Rows.Count).End(xlUp).Row

Set OutlookApp = CreateObject("outlook.application")
Set OutlookMail = OutlookApp.CreateItem(0)

On Error Resume Next
ActiveSheet.Select

Application.ScreenUpdating = False

NbLigne = Ws.Range("A" & Application.Rows.Count).End(xlUp).Row

Ws.Range("A1:G" & NbLigne).Select

With Selection.Parent.MailEnvelope.Item

.To = Ws.Range("J2").Value



.Subject = "Relance facture(s) non approuvée(s)"

.Send

End With

Next i

On Error Resume Next
ActiveSheet.Next.Select

MsgBox "votre mail à été envoyé.", vbInformation + vbOKOnly, "CONFIRMATION ENVOI MAIL"

Application.ScreenUpdating = True

End Sub


Le deuxième morceau créer et qui fonctionne uniquement pour l'onglet "feuil2 »
Sub EnvoiMail()

'Déclaration de variable

Dim Mafeuille As Worksheet 'La feuille contenant le tableau à envoyé
Dim NbLigne As Integer 'Nombre de lignes à récupérer

'Affectation des variables
Set Mafeuille = ThisWorkbook.Sheets("abekkal") 'on defini la feuille sur laquelle on envoi le tableau de bord

'Désactivation du raffraichissement de l'écran
Application.ScreenUpdating = False

'On calcule le nombre de ligne à prendre dans la feuille à partir de la colonne A
NbLigne = Mafeuille.Range("A" & Application.Rows.Count).End(xlUp).Row

'On séléctionne la plage à copier
Mafeuille.Range("A1:G" & NbLigne).Select

'Envoyé le tableau dans le corps d'un mail avec l'instruction VBA "MailEnvelope"
With Selection.Parent.MailEnvelope.Item

'Destinataire Direct
.To = Mafeuille.Range("J2").Value



'Objet du mail
.Subject = "Relance facture(s) non approuvée(s)"

'Envoi du mail
.Send

End With

MsgBox "votre mail à été envoyé.", vbInformation + vbOKOnly, "CONFIRMATION ENVOI MAIL"

Application.ScreenUpdating = True


End Sub

J'ai également mis a votre disposition les copie écran au format JPEG;

Merci d'avance pour votre aide,
Saajo



Configuration: Windows / Chrome 72.0.3626.121
Afficher la suite 

2 réponses

Messages postés
8736
Date d'inscription
lundi 9 juin 2008
Statut
Contributeur
Dernière intervention
18 octobre 2019
436
0
Merci
bonjour, merci d'utiliser les balises de code pour partager un programme.
as-tu une question, comment pouvons-nous t'aider?
Commenter la réponse de yg_be
0
Merci
Merci pour ton retour YG_BE.

Désolé, mais je ne comprends ta remarque concernant les balises.

L'objectif est de faire une boucle prenant en compte une sélection par feuille, à envoyer pour chaque contact correspondant.

Je souhaiterais faire une boucle qui ferait l'action suivante:

Sélectionner/copier les données à partir de la feuille n°4 nommée "abekkal"
Coller dans un mail outlook
Envoyer le mail
Passer à la feuille suivante
Répéter la même action ci-dessus jusqu'à la fin des feuille du classeur

J'ai tenté de créer une boucle à partir de For ou For Each mais aucune des deux fonctionnent.
Néanmoins ma deuxième macro sans la boucle fonctionne pour la feuille "abekkal". Hors, cela voudrais dire que je dois répéter le code au tant de fois qu'il existe de feuille, et multiplierais le nombre de ligne du code.

Je pense que le problème provient de la sélection de la feuille qui désigne une feuille précise et non une feuille une par une. Ci dessous mon code est celui-ci:

=> Set Mafeuille = ThisWorkbook.Sheets("abekkal")

Cela permet de définir la feuille sur laquelle on sélectionne les données et ensuite que l'on colle dans le mail pour envoi.

Idéalement, il faudrait avoir un code permettant de choisir feuille après feuille une fois l'action est terminer.

J'espère avoir été claire et précis.

Encore merci pour ton aide,
Saajo
Saajo
Messages postés
7
Date d'inscription
vendredi 18 janvier 2019
Statut
Membre
Dernière intervention
14 juin 2019
-
Bonjour YG_BE,
Merci pour ton retour et l'aide apportée au sujet (très sympa).

Pour des raison de productivité, j'ai complètement contourné le sujet de la boucle des feuilles en passant par une seule et même feuille appelé "KPI Board" (ci-joint copie écran).



Mon code permettant d'envoyé des mails en masse est celui-ci (il fonctionne, mais n'est pas parfait!):


Sub EnvoiMail()

'Déclaration de variable

Dim LeMail As Variant
Dim Ligne As Integer
Dim LastRow As Integer

'Affectation des variables

Set LeMail = CreateObject("Outlook.Application")

Sheets("KPI Board").Select
LastRow = Range("J40000").End(xlUp).Row

'Départ boucle'
For Ligne = 2 To LastRow

Application.ScreenUpdating = False

    With LeMail.CreateItem(olMailItem)
    
    .To = Range("J" & Ligne) 'SI VIDE ALORS PASSER LA CELLULE EN DESSOUS'
    .Subject = "Relance facture non validées"
    .Body = "Bonjour," & Chr(10) & Chr(13) & "Veuillez trouver ci-desous la liste des factures non encore validées dans ARIBA:" & Chr(10) & Chr(13) & "Référence Ariba: " & Range("A" & Ligne) & "  -  " & "Supplier: " & Range("B" & Ligne) & "  -  " & "Requester: " & Range("C" & Ligne) & "  -  " & "Approbateur: " & Range("D" & Ligne) & "  -  " & "Date d'affectation: " & Range("E" & Ligne) & "  -  " & "Délai de retard: " & Range("G" & Ligne) & " Jours" & Chr(10) & Chr(13) & "Merci de bien vouloir valider dans ARIBA les factures en attentes de validation." & Chr(10) & Chr(13) & "Bonne Journée." & Chr(10) & Chr(13) & "Cordialement," & Chr(10) & Chr(13) & "Service Comptabilité"
    '.CC = "CDFR.RIRE@AYO.COM"

    .Display
       
    End With

Next Ligne

MsgBox "votre mail à été envoyé.", vbInformation + vbOKOnly, "CONFIRMATION ENVOI MAIL"

Sheets("Commande Macro").Select
Range("A1").Select

Application.ScreenUpdating = True


End Sub



Néanmoins, j'ai deux problématiques:

1er Problématique: Lorsque la colonne "J" correspondant au destinataire est VIDE, il me génère une erreur d’exécution avec le message suivant: "le destinataire n'est pas renseigné. assurez vous qu'une valeur soit renseigné".
Normale, puisque la cellule "J5" est vide!
L'objectif ici serait de créer une condition du style: si cellule vide alors passé à la cellule suivante.

2e Problématique: le code n'est pas parfait car il m'envoi un mail pour chaque ligne. C'est à dire pour un même destinataire j'aurai autant de mail envoyé que de lignes. Pas cool pour le destinataire!
L'objectif ici, serait une condition qui dirait: si plusieurs fois le même destinataire alors envoyé l'ensemble des lignes sur un même mail.

Bah voila, voici mon dernier travail actualisé.
Si tu peux m'apporté ton aide sur les 2 problèmatiques citées ci-dessus, cela serait TOP.

Encore merci pour ton temps et dispo.
Bonne journée.
José
yg_be
Messages postés
8736
Date d'inscription
lundi 9 juin 2008
Statut
Contributeur
Dernière intervention
18 octobre 2019
436 > Saajo
Messages postés
7
Date d'inscription
vendredi 18 janvier 2019
Statut
Membre
Dernière intervention
14 juin 2019
-
suggestion, à la place de ta boucle:
Dim dest As String, destprec As String, message As String
destprec = ""
Application.ScreenUpdating = False
For Ligne = 2 To LastRow
    dest = Range("J" & Ligne)
    If dest <> destprec Then
        If destprec <> "" Then
            message = message & Chr(10) & Chr(13) _
                & "Merci de bien vouloir valider dans ARIBA les factures en attentes de validation." & Chr(10) & Chr(13) _
                & "Bonne Journée." & Chr(10) & Chr(13) & "Cordialement," & Chr(10) & Chr(13) & "Service Comptabilité"
            With LeMail.CreateItem(olMailItem)
                .To = destprec 'SI VIDE ALORS PASSER LA CELLULE EN DESSOUS'
                .Subject = "Relance facture non validées"
                .Body = message
                '.CC = "CDFR.RIRE@AYO.COM"
                .Display
            End With
        End If
        destprec = dest
        message = "Bonjour," & Chr(10) & Chr(13) & "Veuillez trouver ci-desous la liste des factures non encore validées dans ARIBA:"
    End If
    message = message & Chr(10) & Chr(13) & "Référence Ariba: " & Range("A" & Ligne) & "  -  " & "Supplier: " _
    & Range("B" & Ligne) & "  -  " & "Requester: " & Range("C" & Ligne) & "  -  " _
    & "Approbateur: " & Range("D" & Ligne) & "  -  " & "Date d'affectation: " & Range("E" & Ligne) & "  -  " _
    & "Délai de retard: " & Range("G" & Ligne) & " Jours"
Next Ligne
Saajo
Messages postés
7
Date d'inscription
vendredi 18 janvier 2019
Statut
Membre
Dernière intervention
14 juin 2019
> yg_be
Messages postés
8736
Date d'inscription
lundi 9 juin 2008
Statut
Contributeur
Dernière intervention
18 octobre 2019
-
Bonsoir YG_BE,

Merci encore pour ton retour.

Après l'avoir testé de long en large, le code fourni fonctionne et correspond parfaitement à ma demande.

Néanmoins, il n'est pas parfait (tout ça pour chipoter)...j'ai remarqué qu'il ne prend pas en compte le dernier contact de la liste.

Jusque la rien de grave puisque la macro m'a permis de générer 292 emails en l'espace de 1'30 secondes ... ce qui me permets d'obtenir un gain de productivité sans égal ! c'est mon boss qui va être heureux :-)

Cependant, j'imagine que la perfection est importante a ce niveau de programmation ?
C'est un peu comme le luxe, la qualité est dans le soucis du détail !
Alors si tu trouves comment faire, je suis preneur.

Quoiqu'il en soit, un grand merci pour ton aide et ça va être un vrai plaisir de relancer mes opérationnels pour les validations factures.

Bonne soirée,
Saajo
yg_be
Messages postés
8736
Date d'inscription
lundi 9 juin 2008
Statut
Contributeur
Dernière intervention
18 octobre 2019
436 > Saajo
Messages postés
7
Date d'inscription
vendredi 18 janvier 2019
Statut
Membre
Dernière intervention
14 juin 2019
-
bien vu!
pour envoyer le dernier email, il faut copier (pas déplacer) les lignes 7 à 18 après la ligne 26.
Saajo
Messages postés
7
Date d'inscription
vendredi 18 janvier 2019
Statut
Membre
Dernière intervention
14 juin 2019
-
Commenter la réponse de Saajo