Envoi mail groupé

Sandrine -  
thev Messages postés 1986 Date d'inscription   Statut Membre Dernière intervention   -
Bonjour à tous,

Je vous explique ma problématique.
Je voudrai envoyer en un clique un mail à toute mes adresses mails contenu dans mon classeur. Qui pleuvent être dans différentes cellules.
J'ai déjà mis en place une vba qui me permet de le faire pour chaque onglet avec un raccourci mais je voudrai le faire pour tout mon classeur...
Pouvez vous m'aider ?

Merci à tous,

A voir également:

1 réponse

Réponse 1 / 1
thev Messages postés 1986 Date d'inscription   Statut Membre Dernière intervention   713
 
ci-dessous code pour l'ensemble du classeur 

Sub envoi_mail()

 Dim feuille As Worksheet
 Dim cellule As Range
 
 For Each feuille In ThisWorkbook.Sheets
   
   If Evaluate("COUNTIF(" & feuille.UsedRange.Address & ",""*@*.*"")") > 0 Then 'au moins une adresse mail présente dans la feuille
        For Each cellule In feuille.UsedRange.Cells      'cellules utilisées de la feuille
            If cellule Like "*@*.*" Then
                'votre code d'envoi du mail ......  avec la variable cellule contenant l'adresse du destinataire
            End If
        Next
   End If
   
 Next


End Sub

 
0
sandrine
 
Bonjour à vous et merci pour votre réponse.

Malheureusement ça ne fonctionne pas....
0
sandrine
 
Le code tourne en rond, 


Sub envoi_mail3()

 Dim feuille As Worksheet
 Dim cellule As Range
    Dim OutApp As Object
    Dim OutMail As Object
    Dim strbody As String
    
 For Each feuille In ThisWorkbook.Sheets
   
   If Evaluate("COUNTIF(" & feuille.UsedRange.Address & ",""*@*.*"")") > 0 Then 'au moins une adresse mail présente dans la feuille
        For Each cellule In feuille.UsedRange.Cells      'cellules utilisées de la feuille
            If cellule Like "*@*.*" Then
            End If
        Next
        
        ' Working in Office 2000-2016

    Set OutApp = CreateObject("Outlook.Application")
    MsgBox ("Préparation du MAIL pour envoie du catalogue PLV Flexico. " & Chr(10) & Chr(10) & "La fenêtre du message va s'afficher" & Chr(10) & "Merci de valider l'envoi")
    Set OutMail = OutApp.CreateItem(0)

    On Error Resume Next

    With OutMail
        .Display
        .To = Range("L2").Value
        .CC = ""
        .BCC = ""
        .Subject =
      
    End With

    On Error GoTo 0
    Set OutMail = Nothing
    Set OutApp = Nothing

   End If
 Next


End Sub
0
thev Messages postés 1986 Date d'inscription   Statut Membre Dernière intervention   713 > sandrine
 
Bonjour,

Votre code n'est pas inséré au bon endroit et il manque l'instruction send pour envoyer le mail.
Ci-dessous code 

Sub envoi_mail3()

    Dim feuille As Worksheet
    Dim cellule As Range
    Dim OlApp As Object
    Dim email As Object
    
    Set OlApp = CreateObject("Outlook.Application")   'création instance application outlook
    
    For Each feuille In ThisWorkbook.Sheets
   
        If Evaluate("COUNTIF(" & feuille.UsedRange.Address & ",""*@*.*"")") > 0 Then 'au moins une adresse mail présente dans la feuille
            
            For Each cellule In feuille.UsedRange.Cells      'cellules utilisées de la feuille
                If cellule.Value Like "*@*.*" Then
                    ' Working in Office 2000-2016
                    MsgBox ("Préparation du MAIL pour envoie du catalogue PLV Flexico. " & Chr(10) & Chr(10) & "La fenêtre du message va s'afficher" & Chr(10) & "Merci de valider l'envoi")
                    Set email = OlApp.CreateItem(olMailItem)
                    On Error Resume Next
                    With email
                        .Display
                        .To = cellule.Value    'destinataire
                        .CC = ""
                        .BCC = ""
                        .Subject = "Votre objet"
                        .Body = "Corps du mail"
                        .Send     ' envoie le message
                    End With
                    On Error GoTo 0
                    Set email = Nothing
                End If
            Next
    
       End If
    
    Next
    
    Set OlApp = Nothing
    

End Sub
0

Discussions similaires

Rétrodiffusion "Mail Delivery System"
baissaoui -
baissaoui -

0 réponse
Envoi sms à plusieurs contacts sans passer par un groupe
guynemer95 -
guynemer95 -

8 réponses
Echec d'envoi message sur Messenger
Kris68 -
Colibri -

2 réponses