Envoyer des mails avec VBA

Abrahel

XLDnaute Nouveau
Bonjour le forum :)

Je reviens vers vous pour un petit dossier qui me turlupine (non y'a pas de gros mot :eek: )

J'ai une liste de clients avec leur adresse mail, je peux envoyer un mail à chacun d'entre eux individuellement via Excel, ça fonctionne à la perfection.

Cependant, je ne peux pas faire de mail groupé (envoyer le même mail à toute ma liste) ou envoyer le même mail à seulement quelques contacts de la liste...

Quelqu'un saurait-il faire? :D

Ci joint un bout de mon fichier pour une meilleure explication

Bien cordialement :)
 

Pièces jointes

  • Test mails auto.xlsm
    17.8 KB · Affichages: 131

Roland_M

XLDnaute Barbatruc
Re : Envoyer des mails avec VBA

re

voir ces routines pour outlook:
Code:
'pour éviter les erreurs de library ...
'- au lieu de faire -
'Dim MonOutlook As Outlook.Application
'- faire comme ceci et Excel va se servir de la bonne version de Outlook selon le poste
'Dim MonOutlook As Object
'Set MonOutlook = CreateObject("Outlook.Application")
'...
'ThisWorkbook.VBProject.References.AddFromFile
'Application.Version

Public Sub ActiveRef() 'Active la référence à Outlook selon la version d'excel
Dim AdresseRef As String, V As Integer
V = Val(Application.Version)
Select Case V
  Case 7: '1995
          'AdresseRef = "L'adresse du fichier"
  Case 8: '1997
          'AdresseRef = "L'adresse du fichier"
  Case 9: '2000
          'AdresseRef = "L'adresse du fichier"
 Case 10: '2001
          'AdresseRef = "L'adresse du fichier"
 Case 11: '2003
           AdresseRef = "c:\Program Files\Microsoft Office\OFFICE11\msoutl.olb"
 Case 12: '2007
 Case 13, 14: '2010
          'AdresseRef = "L'adresse du fichier"
End Select
If AdresseRef > "" Then
   On Error Resume Next
   ThisWorkbook.VBProject.References.AddFromFile AdresseRef
   On Error GoTo 0
End If
End Sub


Sub UseOutlook(strTo As String, strCC As String, strNomFichier As String, strSujet As String, strTexte As String)
  Dim MonOutlook As Object
  Dim MonMessage As Object
  Dim strNomClasseur As String
  
  Set MonOutlook = CreateObject("Outlook.Application")
  Set MonMessage = MonOutlook.CreateItem(0)
  strNomClasseur = strNomFichier
  
  On Error GoTo fin
    
  Sheets(strNomFichier).Copy
  ActiveWorkbook.SaveAs ("c:\" & strNomFichier & ".xls")
  strNomFichier = ActiveWorkbook.FullName

  MonMessage.To = strTo
  MonMessage.CC = strCC
  MonMessage.Attachments.Add strNomFichier
  MonMessage.Subject = strSujet
  MonMessage.Body = strTexte
  MonMessage.Send

  Workbooks(strNomClasseur).Close SaveChanges:=False
  Kill (strNomFichier)
  Set MonOutlook = Nothing
  Exit Sub
  
fin:
    MsgBox Err.Description
    Select Case Err.Number
        Case 9
            MsgBox "La valeur de la feuille est invalide" + vbCr + vbCr + "Opération annulé", vbCritical
        Case 1004, 287
            MsgBox "Une erreur est survenue durant la procédure" + vbCr + vbCr + "Opération annulé", vbCritical
            Workbooks(strNomClasseur).Close SaveChanges:=False
            Kill (strNomFichier)
    End Select
    Set MonOutlook = Nothing
    Set MonMessage = Nothing
End Sub

Code:
'Thierry (XLD) - complètée JNP et Roland
'La référence à OutLook doit être activée dans Outils -> Références ...
'MicroSoft OutLook 12.0 Object Library (pour 2007) et 11.0 pour 2003 etc.

Private Sub EnvoiMailOutlook()
Dim OLApplication As Outlook.Application, OLMail As Outlook.MailItem
Set OLApplication = CreateObject("Outlook.Application")
Set OLMail = OLApplication.CreateItem(OLMailItem)
With OLMail
      .To = "toto@toto.fr" ' Destinataire
      .CC = "titi@titi.fr" ' Copie
      .BCC = "tutu@tutu.fr" ' Copie invisible
      .Importance = olImportanceNormal
      .Subject = "Coucou" ' Sujet
      .Body = "Bonjour chez vous" & vbCrLf & "Tata" ' Message
      .Attachments.Add "C:\Pièce à joindre.pdf" ' Pièce jointe
      .Categories = "Daily"
      .OriginatorDeliveryReportRequested = True ' Accusé de dépôt
      .ReadReceiptRequested = True ' Accusé de lecture
      'Send et Display ne doivent pas être utiliser simultanément
     '.Send '<<<<<<<<<<<< Pour envoyer directement
      .Display '<<<<<<<<< Pour voir le mail avant envoi
End With
Set OLApplication = Nothing: Set OLMail = Nothing
End Sub

Private Sub EnvoiMailOutlookAvecFeuilJointe()
Dim OutApp As Object, OutMail As Object, NewB As Workbook
'---- variables nécessaire ------------
NomDuClasseur$ "NomDeLaPieceJointe.xls" ' avec son extention !
NomDeLaFeuille$ = "Feuil3"
AdresMail$ = "nom@site.fr"
AdresMailCC$ = "nom@site.fr"
AdresMailBCC$ = "nom@site.fr"
Sujet$ ""
Message$ = ""
'--------------------------------------

' Copie la feuille (ce qui cré un nouveau classeur qui devient actif)
CheminFichier$ = ThisWorkbook.Path & "\" & NomDuClasseur$ 'ajoute le chemin
Sheets(NomDeLaFeuille$).Copy
Set NewB = ActiveWorkbook
ActiveWorkbook.SaveAs CheminFichier$
' ENVOI
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
On Error GoTo ErreurNET
With OutMail
 .To = AdresMail$
 .CC = AdresMailCC$
 .BCC = AdresMailBCC$
 .Subject = Sujet$
 .Body = Message$
 .Attachments.Add NewB.FullName
 .Display
End With
' close le classeur et le supprime du disque
ActiveWorkbook.Close
Kill CheminFichier$
' fin
Set OutApp = Nothing: Set OutMail = Nothing: Set NewB = Nothing
On Error GoTo 0: Err.Clear
Exit Sub
ErreurNET: ' sous prog erreur
Msg$ = "Erreur " & Err.Source & "  No " & Err.Number & vbLf & vbLf & Err.Description
T$ = "Envoi Mail: Problème de connexion !?"
MsgBox Msg$, vbCritical, T$, Err.HelpFile, Err.HelpContext
On Error GoTo 0: Err.Clear
End Sub
 

Abrahel

XLDnaute Nouveau
Re : Envoyer des mails avec VBA

Rebonjour le forum

Navré de faire le lourd :eek:

Je pense avoir solutionné mon problème, je laisse un fichier avec les macros disponibles, si cela peut aider en retour... et si quelqu'un a des astuces pour modifier/améliorer le code ou autre!

Bonne journée, bien cordialement :)

EDIT: Voilà c'est bon, en trois fichiers ça passe :p
 

Pièces jointes

  • Test mail auto1.xlsm
    16.7 KB · Affichages: 157
  • Test mail auto2.xlsm
    17.6 KB · Affichages: 124
  • Test mail auto3.xlsm
    15.6 KB · Affichages: 130
Dernière édition:

Usine à gaz

XLDnaute Barbatruc
Supporter XLD
Re : Envoyer des mails avec VBA

Bonjour tout le monde,
Re-Roland,

Décidément, je t'aurai donné de l'occupation aujourd'hui LOL.

Je vais voir et tester tes nouveaux fichiers.

Pour l'instant, je suis sur ton fichier : EnvoiMail CDOsmtpHTML_3plus

J'ai un beug quand j'essaie d'envoyer une feuille dans le corps du mail :
voir pièce jointe.
Lionel,
 

Pièces jointes

  • Sans titre.jpg
    Sans titre.jpg
    116.4 KB · Affichages: 111

Roland_M

XLDnaute Barbatruc
re

peux tu me montrer ce qu'il y a dans la feuille que tu veux mettre dans le corps du message !
car cette fonction n'est valable que pour un range de données pour autre chose avec par exemple des graph ça ne copiera pas il faut mettre en pièce jointe !
mais j'aimerais tout même voir le contenu de cette feuille !
tu aurais du faire débogage pour moi voir la ligne incriminée !

en attendant j'y regarde !

EDIT: je viens de faire un essai et je n'ai pas ce problème !?
 
Dernière édition:

Discussions similaires

Réponses
2
Affichages
99
Réponses
1
Affichages
785
Compte Supprimé 979
C

Membres actuellement en ligne

Aucun membre en ligne actuellement.

Statistiques des forums

Discussions
311 725
Messages
2 081 941
Membres
101 848
dernier inscrit
Djigbenou