XL 2010 Mail multi destinataires.

[counterbob]

Bonsoir
Dans une feuille "Parametre" la colonne A contient les adresses Mails, la colonne B contient 1 ou 0
1 pour envoi , 0 pour pas d'envoi.
J"ai réalisé ce code qui se répète 12 fois car 12 destinataire mais l'envoi ne se réalise pas pour tous les destinataires.
Une ideé ? un conseil serait bienvenue
Merci

Private Sub mail() 'envoi mail aux destinataires
Sheets("Envoi").Select

Dim destinataire As String 'variable destinataire


If Sheets("Parametre").Range("e2") = 1 Then 'ActiveSheet.Range("k1") = 1 Then 'si la valeur de la cellule k1 est égale à 1 alors
ActiveSheet.Range("A1:g15").Select 'sélectionne la plage A1:g15
destinataire = Sheets("Parametre").Range("D2").Value 'ActiveSheet.Range("L1").Value 'définit le destinataire de la cellule P1
ActiveWorkbook.EnvelopeVisible = True

With ActiveSheet.MailEnvelope 'génère l'envoi de la sélection par mail au destinataire

.Item.To = destinataire 'destinataire du mail

.Item.Subject = "demande de prestation nmr: " & Range("A3").Value 'objet du mail

' .item.body="

.Item.Send 'envoi du mail

End With
End If

'envoi par mail du bulletin

If Sheets("Parametre").Range("e3") = 1 Then 'si la valeur de la cellule k1 est égale à 1 alors
ActiveSheet.Range("A1:g15").Select 'sélectionne la plage A1:g15
destinataire = Sheets("Parametre").Range("D3").Value 'définit le destinataire de la cellule P1
ActiveWorkbook.EnvelopeVisible = True

With ActiveSheet.MailEnvelope 'génère l'envoi de la sélection par mail au destinataire

.Item.To = destinataire 'destinataire du mail

.Item.Subject = "demande de prestation nmr: " & Range("A3").Value 'objet du mail

.Item.Send 'envoi du mail

End With
End If

 

[Hieu]

Salut,

Une idée pour quelque chose qui se répète :

Sub mail() 'envoi mail aux destinataires
Sheets("Envoi").Select

Dim destinataire As String 'variable destinataire

For i = 2 To 13
If Sheets("Parametre").Range("b" & i) = 1 Then 'ActiveSheet.Range("k1") = 1 Then 'si la valeur de la cellule k1 est égale à 1 alors
Sheets("Envoi").Range("A1:g15").Select  'sélectionne la plage A1:g15
    destinataire = Sheets("Parametre").Range("a" & i).Value '   'définit le destinataire de la cellule a2
   ActiveWorkbook.EnvelopeVisible = True

   With ActiveSheet.MailEnvelope 'génère l'envoi de la sélection par mail au destinataire

      .Item.To = destinataire 'destinataire du mail

      .Item.Subject = "demande de prestation : " & Sheets("Envoi").Range("A3").Value   'objet du mail
     
     ' .item.body="

      .Item.Send    'envoi du mail

   End With
End If

  'envoi par mail du bulletin
Next i
End Sub

 

[counterbob]

Salut,

Une idée pour quelque chose qui se répète :

Sub mail() 'envoi mail aux destinataires
Sheets("Envoi").Select

Dim destinataire As String 'variable destinataire

For i = 2 To 13
If Sheets("Parametre").Range("b" & i) = 1 Then 'ActiveSheet.Range("k1") = 1 Then 'si la valeur de la cellule k1 est égale à 1 alors
Sheets("Envoi").Range("A1:g15").Select  'sélectionne la plage A1:g15
    destinataire = Sheets("Parametre").Range("a" & i).Value '   'définit le destinataire de la cellule a2
   ActiveWorkbook.EnvelopeVisible = True

   With ActiveSheet.MailEnvelope 'génère l'envoi de la sélection par mail au destinataire

      .Item.To = destinataire 'destinataire du mail

      .Item.Subject = "demande de prestation : " & Sheets("Envoi").Range("A3").Value   'objet du mail
    
     ' .item.body="

      .Item.Send    'envoi du mail

   End With
End If

  'envoi par mail du bulletin
Next i
End Sub

 

[counterbob]

Bonjour
merci
C'est pourtant si logique.... pourquoi je n'y ai pas pensé???
Je testerai sur mon pc qui possède outlook.
Bonne soirée

 

[KIM]

Bonjour Hieu, Counterbob, et le forum,
Intéressé par ce sujet, je viens de tester la macro de Hieu. Elle fonctionne. Elle envoie par mél le même onglet à toutes les adresses dont la col B contient 1.
Ma problématique est :
Est-il possible d'envoyer un onglet différent à chacun ?
et si oui Comment faire ?
Par avance merci de votre aide.
KIM

 

[Hieu]

Salut,
On peut tout faire :

Sub mail()
Dim destinataire As String
For i = 2 To 13
destinataire = Sheets("Parametre").Range("a" & i).Value
onglet = Sheets("Parametre").Range("d" & i).Value
If Sheets("Parametre").Range("b" & i) = 1 Then Call message(destinataire, onglet)
Next i
End Sub
Sub message(dest, ong)

Sheets(ong).Select
Sheets(ong).Range("A1:g15").Select

Set m = ActiveSheet.MailEnvelope

ActiveWorkbook.EnvelopeVisible = True
      m.Item.To = dest
      m.Item.Subject = "demande de prestation : " & Sheets(ong).Range("A3").Value
     ' m.item.body="
      m.Item.Send
End Sub

En repartant du fichier du counterbob, pour exemple ; créé une subroutine pour un peu de clarté

 

[KIM]

Re bonjour Hieu & le fil,
1/ A l'exécution de ton dernier fichier,
Le premier mél seulement est parti, ensuite j'ai une erreur :
"La méthode "MailEnvelope" de l'objet "_Worksheet" a échoué"
sur la ligne
Set m = ActiveSheet.MailEnvelope


2/ J'ai plus de 50 onglets à transmettre, les 4 premiers caractères sont connus par exemple DT02 ou DT04 etc. Est-il possible d'utiliser dans la col D le car "*" par exemple envoyer par mél le ou les onglets qui commencent par DT02* ou DT04* .

Merci d'avance

KIM

 

[counterbob]

Re bonjour Hieu & le fil,
1/ A l'exécution de ton dernier fichier,
Le premier mél seulement est parti, ensuite j'ai une erreur :
"La méthode "MailEnvelope" de l'objet "_Worksheet" a échoué"
sur la ligne
Set m = ActiveSheet.MailEnvelope


2/ J'ai plus de 50 onglets à transmettre, les 4 premiers caractères sont connus par exemple DT02 ou DT04 etc. Est-il possible d'utiliser dans la col D le car "*" par exemple envoyer par mél le ou les onglets qui commencent par DT02* ou DT04* .

Merci d'avance

KIM

Bonsoir
Cette macro pour lister les onglets
Sub ListerOnglets()
' Liste uniquement les onglets de type "Feuille"
' Les onglets de type "Graphique" ne sont pas inclus
'
Dim i As Integer

For i = 2 To Worksheets.Count
Cells(i, 4) = Worksheets(i).Name 'Colonne D =4

Next i
End Sub


Pour trier les onglets
Sub TriDesOnglets()
'tri les feuilles par ordre croissant
Dim i As Integer, j As Integer
For i = 2 To Sheets.Count 'pour débuter le tri à la feuille x remplacer For I = 1 pat For I = x
For j = 2 To i - 1 'pour débuter le tri à la feuille x remplacer For J = 1 par For J = x
If UCase(Sheets(i).Name) < UCase(Sheets(j).Name) Then 'pour tri décroissant remplacer < par >
Sheets(i).Move Before:=Sheets(j)
Exit For
End If
Next j

 

[KIM]

Bonsoir Counterbob, bonsoir Hieu,
1/ @counterbob,
En effet c'est très pratique de lister les onglets pour compléter la col D du fichier de Hieu de la discussion #6. Merci.

2/@Hieu,
Le message d'erreur suivant persiste et seulement un seull mail pour la 1è adresse part ensuite le message ci-dessous apparait. C'est le même fichier de la discussion #6
"La méthode "MailEnvelope" de l'objet "_Worksheet" a échoué"
sur la ligne
Set m = ActiveSheet.MailEnvelope

Merci de votre aide
KIM

 

[Hieu]

Retest par là :
Modif de la subroutine message

Sub mail()
Dim destinataire As String
For i = 2 To 13
destinataire = Sheets("Parametre").Range("a" & i).Value
onglet = Sheets("Parametre").Range("d" & i)
If Sheets("Parametre").Range("b" & i) = 1 Then Call message(destinataire, onglet)
Next i
Sheets("Parametre").Select
End Sub
Sub message(dest, ong)
Sheets(ong).Select
Sheets(ong).Range("A1:g15").Select
ActiveWorkbook.EnvelopeVisible = True
With ActiveSheet.MailEnvelope
    .Item.To = dest
    .Item.Subject = "demande de prestation : " & Sheets(ong).Range("A3").Value
    ' .item.body="
    .Item.Send
End With
End Sub

Normalement, ça marche

 

[KIM]

Bonsoir le fil,
Merci Huet, J'ai 3 adresses méls dans la col A, les 3 messages sont transmis et reçus.
Par contre la macro se termine par le message d'erreur :
Erreur d'exécution 9
L'indice n'appartient pas à la sélection,
et pointe dans la macro: Sub message(dest, ong)
A la ligne
Sheets(ong).Select

Merci encore de ton aide
KIM

 

[Hieu]

C'est qui Huet ? ^^

Fais attention à la boucle qui va de 2 à 13... A adapter, selon ton besoin.

Peux-tu me mettre ton fichier (avec des données bidon)

 

[KIM]

Merci Hieu, et le fil,
Désolé erreur de frappe pour Huet.
Tout est rentré dans l'ordre. En effet après avoir réduit le nombre de mél, il restait 1 dans la col B sans mél dans la col A.

Merci pour tout.

Bonne soirée
KIM