Macro envoi mails

Bonjour,

J'ai trouvé une super macro qui permet d'envoyer en automatique un classeur tout prêt. Je veux svp lui rajouter des fonctions en boucle, afin qu'elle puisse elle même chercher le chemin du fichier et le destinataire. j'ai une liste de mailing que vous trouverez ci-joint avec en colonne A la liste des pays, colonne B la liste des emails, et en colonne C le chemin des fichier. Et donc l'idée est que la macro cherche pour le pays en A4 le destinataire B4 et envoie le fichier en C4, ainsi de suite pour le reste de la liste. Merci d'avance pour vos aides précieuses !

'Il faut activer la référence "Microsoft Outlook Library" Avant de lancer cette macro,

' Dans l'éditeur VBA: Faire Menu / Tools / Reference / Cocher "Microsoft Outlook Library"

Sub Envoyer_Mail_Outlook()

Dim ObjOutlook As New Outlook.Application

Dim oBjMail

Dim Nom_Fichier As String

Set ObjOutlook = New Outlook.Application

Set oBjMail = ObjOutlook.CreateItem(olMailItem)

'---------------------------------------------------------

'Exemple pour envoyer un classeur en pièce jointe

'Nom_Fichier = Application.GetOpenFilename("Fichier excel (*.xls;*.xlsx;*.xlsm), *.xls;*.xlsx;*.xlsm")

'If Nom_Fichier = "Faux" Then Exit Sub

'---------------------------------------------------------

'Ou bien entrer le path et nom du fichier autrement

Nom_Fichier = "C:\Chemin\NomFichier.ext"

If Nom_Fichier = "" Then Exit Sub

'---------------------------------------------------------

With oBjMail

.To = "LeClient@gmail.com" ' le destinataire

.Subject = "Ici c'est l'objet" ' l'objet du mail

.Body = "Ici le texte du mail " 'le corps du mail ..son contenu

.Attachments.Add Nom_Fichier '"C:\Data\essai.txt" ' ou Nomfichier

.Display ' Ici on peut supprimer pour l'envoyer sans vérification

.Send

End With

ObjOutlook.Quit

Set oBjMail = Nothing

Set ObjOutlook = Nothing

End Sub

Cordialement,

Hajar

Bonjour,

Sub test()
Dim LastRw As Long, i As Long
LastRw = Sheets("Feuil1").Cells(Rows.Count, 2).End(xlUp).Row
  For i = LastRw To Sheets("Feuil1").Cells(Cells.Count, 2).End(xlUp).Row
    Envoyer_Mail_Outlook Sheets("Feuil1").Range("B" & i), Sheets("Feuil1").Range("C" & i)
  Next
End Sub

Function Envoyer_Mail_Outlook(dest As String, fich As String)
'Nécessite d'activer la référence "Microsoft Outlook Library"
Dim ObjOutlook As New Outlook.Application
Dim oBjMail
Dim Nom_Fichier As String

    Set ObjOutlook = New Outlook.Application
    Set oBjMail = ObjOutlook.CreateItem(olMailItem)

    If Nom_Fichier = "" Then Exit Function
     With oBjMail
       .To = dest ' le destinataire
       .Subject = "Ici c'est l'objet"          ' l'objet du mail
       .Body = "Ici le texte du mail "  'le corps du mail ..son contenu
       .Attachments.Add fich
       .Display  '   Ici on peut supprimer pour l'envoyer sans vérification
       .Send
    End With
    ObjOutlook.Quit
    Set oBjMail = Nothing
    Set ObjOutlook = Nothing
End Function

Bonjour,

merci pour votre macro. J'ai un message d'erreur "Dépassement de capacité" au niveau de la ligne "For i = LastRw To Sheets("Feuil1").Cells(Cells.Count, 2).End(xlUp).Row"

Avez vous une idée de quoi il peut s'agir ?

Merci d'avance.

Cordialement,

Hajar

Bonjour,

et que représente pour toi : Cells.Count ...

essai plutôt de le remplacer par :

 Sheets("Feuil1").Rows.count

remplacer

For i = LastRw To Sheets("Feuil1").Cells(Cells.Count, 2).End(xlUp).Row

par

For i =4 to  LastRw

Bonjour

Merci pour votre retour. cette fois je n'ai pas de message d'erreur mais je ne reçois aucun email (j'ai fait le teste avec mon adresse électronique et je n'ai rien reçu...).

Cdt,

Hajar

re,

tu appliqué qu'elle modification ... moi j'ai juste regardé ton problème de message de défaut .. Sabv à lui regardé le fonctionnement de la macro..

Re

j'ai pris en compte le message de SabV

Cdt

Hajar

ou renseigne tu ta variable Nom_Fichier ?

 If Nom_Fichier = "" Then Exit Function

colonne A du fichier d'origine

Cdt

hajar91 a écrit :

colonne A du fichier d'origine

Cdt

??? dans ton code ?

je reprend au complet,

Sub test()
Dim LastRw As Long, i As Long
LastRw = Sheets("Feuil1").Cells(Rows.Count, 2).End(xlUp).Row
  For i = 4 To LastRw
    Envoyer_Mail_Outlook Sheets("Feuil1").Range("B" & i), Sheets("Feuil1").Range("C" & i)
  Next
End Sub

Function Envoyer_Mail_Outlook(dest As String, fich As String)
'Nécessite d'activer la référence "Microsoft Outlook Library"
Dim ObjOutlook As New Outlook.Application
Dim oBjMail
Dim Nom_Fichier As String

    Set ObjOutlook = New Outlook.Application
    Set oBjMail = ObjOutlook.CreateItem(olMailItem)

   Nom_Fichier = fich
    If Nom_Fichier = "" Then Exit Function
     With oBjMail
       .To = dest ' le destinataire
       .Subject = "Ici c'est l'objet"          ' l'objet du mail
       .Body = "Ici le texte du mail "  'le corps du mail ..son contenu
       .Attachments.Add fich '"C:\Data\essai.txt" ' ou Nomfichier
       .Display  '   Ici on peut supprimer pour l'envoyer sans vérification
       .Send
    End With
    ObjOutlook.Quit
    Set oBjMail = Nothing
    Set ObjOutlook = Nothing
End Function

Bonjour,

Je suis toujours bloquée sur cette macro svp. En fait je pense que la macro ne définit pas l'emplacement des destinataires ni le chemin du fichier à envoyer. Pouvez vous m'aider svp ?

pour rappel les noms de ficheirs sont dans les cellules A4...An

les destinataires B4...Bn

et la source du fichier C4...Cn

Sub test()

Dim LastRw As Long, i As Long

LastRw = Sheets("Feuil1").Cells(Rows.Count, 2).End(xlUp).Row

For i = 4 To LastRw

Envoyer_Mail_Outlook Sheets("Feuil1").Range("B" & i), Sheets("Feuil1").Range("C" & i)

Next

End Sub

Function Envoyer_Mail_Outlook(dest As String, fich As String)

'Nécessite d'activer la référence "Microsoft Outlook Library"

Dim ObjOutlook As New Outlook.Application

Dim oBjMail

Dim Nom_Fichier As String

Set ObjOutlook = New Outlook.Application

Set oBjMail = ObjOutlook.CreateItem(olMailItem)

If Nom_Fichier = "" Then Exit Function

With oBjMail

.To = dest ' le destinataire

.Subject = "Ici c'est l'objet" ' l'objet du mail

.Body = "Ici le texte du mail " 'le corps du mail ..son contenu

.Attachments.Add fich

.Display ' Ici on peut supprimer pour l'envoyer sans vérification

.Send

End With

ObjOutlook.Quit

Set oBjMail = Nothing

Set ObjOutlook = Nothing

End Function

Merci d'avance.

Cordialement,

Hajar

Je suis toujours bloquée sur cette macro svp. En fait je pense que la macro ne définit pas l'emplacement des destinataires ni le chemin du fichier à envoyer, pour rappel les noms de ficheirs sont dans les cellules A4...An

les destinataires B4...Bn

et la source du fichier C4...Cn

mais si

Envoyer_Mail_Outlook Sheets("Feuil1").Range("B" & i), Sheets("Feuil1").Range("C" & i)

mais est ce bien l'onglet "Feuil1" et les données en colonne A, B et C sont il bien comme ceux-ci ?

Exemple 1 client@gmail.com C:\Users\utilisateur\Exemple 1.xlsx

en fait si la réponse est oui, la colonne A n'est pas utile pour la macro

Désolée je n'avais pas vu que tu as répondu le 9mai. Du coup j('ai repris ton dernier code ça marche super bien !!!

Dernière faveur stp: comment mettre en objet du mail en automatique la cellule A4 ?

Merci d'avance !

Cordialement,

Hajar

Bonjour Hajar,

voici le fichier avec l'objet ajouter à la macro

Bonjour,

Une dernière demande stp: est ce possible de préciser dans la macro les destinataires en colonne B et les destinataires en copie (CC) en colonne c (à insérer du coup) ? ça serait vraiment top si on peut faire ce paramétrage !

Merci d'avance.

Cordialement,

Hajar

pourrais-tu joindre un nouveau fichier avec la nouvelle disposition des données ?

Oui tu le trouveras ci-joint

Aussi le code avec le nom de l'objet en automatique ne marche pas

merci d'avance.

Cordialement,

Hajar

voilà,