Envoyer mail à plusieurs destinataires avec case à cocher
Fermé
VALENTIN
-
12 mai 2016 à 17:38
MIMOHUGUES Messages postés 4 Date d'inscription jeudi 12 mai 2016 Statut Membre Dernière intervention 19 mai 2016 - 19 mai 2016 à 12:24
MIMOHUGUES Messages postés 4 Date d'inscription jeudi 12 mai 2016 Statut Membre Dernière intervention 19 mai 2016 - 19 mai 2016 à 12:24
A voir également:
- Case à cocher outlook
- Nouveau outlook - Accueil - Mail
- Postmaster outlook - Forum Hotmail / Outlook.com
- Compte outlook gratuit - Guide
- Aller à la ligne dans une case excel - Guide
- Case à cocher open office - Forum LibreOffice / OpenOffice
2 réponses
thev
Messages postés
1882
Date d'inscription
lundi 7 avril 2008
Statut
Membre
Dernière intervention
26 octobre 2024
689
Modifié par thev le 13/05/2016 à 12:08
Modifié par thev le 13/05/2016 à 12:08
'Assignation de l'application Outlook :
Set OutlookApp = CreateObject("outlook.application")
' Assignation des objets Outlook :
Set OutlookMail = OutlookApp .CreateItem(olMailItem)
' remplissage destinataires "A"
destinataire = Array("IBM1", "TELMMA1")
For i_destinataire = 0 To UBound(destinataire)
Set dest_A = OutlookMail.Recipients.Add(destinataire(i_destinataire))
dest_A.Type = olTo
Next i_destinataire
'remplissage sujet et objet
OutlookMail.Subject = sujet
OutlookMail.Body = message
'envoie le message
OutlookMail.Send
thev
Messages postés
1882
Date d'inscription
lundi 7 avril 2008
Statut
Membre
Dernière intervention
26 octobre 2024
689
Modifié par thev le 13/05/2016 à 15:02
Modifié par thev le 13/05/2016 à 15:02
Public Sub EnvoiAutomatiqueMail()
If MsgBox("Souhaitez-vous envoyer ce mail ?", vbQuestion + vbYesNo, "ENVOIE MAIL") = vbYes Then
Dim OutlookApp As Object
Dim OutlookMail As Object
Dim adresse As String
Dim adresses()
Dim message As String
Dim sujet As String
Dim destinataires As Range
If IBM Then
If destinataires Is Nothing Then
Set destinataires = Range("D63,D64,D65,D66")
Else
Set destinataires = Union(destinataires, Range("D63,D64,D65,D66"))
End If
End If
If ENGIE Then
If destinataires Is Nothing Then
Set destinataires = Range("E63,E64,E65,E66")
Else
Set destinataires = Union(destinataires, Range("E63,E64,E65,E66"))
End If
End If
If GRT Then
If destinataires Is Nothing Then
Set destinataires = Range("F63,F64,F65,F66")
Else
Set destinataires = Union(destinataires, Range("F63,F64,F65,F66"))
End If
End If
If TELMMA Then
If destinataires Is Nothing Then
Set destinataires = Range("A63,A64,A65,A66")
Else
Set destinataires = Union(destinataires, Range("A63,A64,A65,A66"))
End If
End If
If PCS Then
If destinataires Is Nothing Then
Set destinataires = Range("B63,B64,B65,B66")
Else
Set destinataires = Union(destinataires, Range("B63,B64,B65,B66"))
End If
End If
If MULTITECH Then
If destinataires Is Nothing Then
Set destinataires = Range("C63,C64,C65,C66")
Else
Set destinataires = Union(destinataires, Range("C63,C64,C65,C66"))
End If
End If
sujet = " Intervention EUROPE AVENUE "
message = "Bonjour" & " " & Range("CT44") & vbCrLf & vbCrLf & "Bienvenue sur les tests" & vbCrLf & vbCrLf & "SIGNATURE"
adresses = destinataires.Value
'Assignation de l'application Outlook :
Set OutlookApp = CreateObject("outlook.application")
'Assignation des objets Outlook :
Set OutlookMail = OutlookApp.CreateItem(olMailItem)
'remplissage sujet et objet
OutlookMail.Subject = sujet
OutlookMail.Body = message
'remplissage destinaires
For i_soc = 1 To UBound(adresses, 2)
For i_dest = 1 To UBound(adresses, 1)
Set dest_A = OutlookMail.Recipients.Add(adresses( i_dest, i_soc))
dest_A.Type = olTo
Next i_dest
Next i_soc
'envoie le message
OutlookMail.Send
End If
End Sub
MIMOHUGUES
Messages postés
4
Date d'inscription
jeudi 12 mai 2016
Statut
Membre
Dernière intervention
19 mai 2016
17 mai 2016 à 13:58
17 mai 2016 à 13:58
merci pour votre aide vraiment :) par contre j'ai entrée les modification mais j'ai toujours un message d'erreur qui me dit "l'indice n'appartient pas a la sélection" j'ai essayé des modification ce week end mais rein de concluant
thev
Messages postés
1882
Date d'inscription
lundi 7 avril 2008
Statut
Membre
Dernière intervention
26 octobre 2024
689
>
MIMOHUGUES
Messages postés
4
Date d'inscription
jeudi 12 mai 2016
Statut
Membre
Dernière intervention
19 mai 2016
Modifié par thev le 17/05/2016 à 17:07
Modifié par thev le 17/05/2016 à 17:07
Pour que je puisse vous aider, il faut me préciser à quelle instruction se produit l'erreur.
Il se peut que la modification de la fin du code ci-dessous (après l'instruction message =) vous permette d'y voir plus clair.
Pour que ça fonctionne, il faut qu'au moins une des variables booléennes : IBM, ENGIE, GRT, TELMMA, PCS, MULTITECH soit égale à TRUE. En bonne logique, votre procédure devrait être la suivante :
Il se peut que la modification de la fin du code ci-dessous (après l'instruction message =) vous permette d'y voir plus clair.
Pour que ça fonctionne, il faut qu'au moins une des variables booléennes : IBM, ENGIE, GRT, TELMMA, PCS, MULTITECH soit égale à TRUE. En bonne logique, votre procédure devrait être la suivante :
Public Sub EnvoiAutomatiqueMail(IBM, ENGIE, GRT, TELMMA, PCS, MULTITECH)
If MsgBox("Souhaitez-vous envoyer ce mail ?", vbQuestion + vbYesNo, "ENVOIE MAIL") = vbYes Then
Dim OutlookApp As Object
Dim OutlookMail As Object
Dim adresse As String
Dim adresses()
Dim message As String
Dim sujet As String
Dim destinataires As Range
If IBM Then
If destinataires Is Nothing Then
Set destinataires = Range("D63,D64,D65,D66")
Else
Set destinataires = Union(destinataires, Range("D63,D64,D65,D66"))
End If
End If
If ENGIE Then
If destinataires Is Nothing Then
Set destinataires = Range("E63,E64,E65,E66")
Else
Set destinataires = Union(destinataires, Range("E63,E64,E65,E66"))
End If
End If
If GRT Then
If destinataires Is Nothing Then
Set destinataires = Range("F63,F64,F65,F66")
Else
Set destinataires = Union(destinataires, Range("F63,F64,F65,F66"))
End If
End If
If TELMMA Then
If destinataires Is Nothing Then
Set destinataires = Range("A63,A64,A65,A66")
Else
Set destinataires = Union(destinataires, Range("A63,A64,A65,A66"))
End If
End If
If PCS Then
If destinataires Is Nothing Then
Set destinataires = Range("B63,B64,B65,B66")
Else
Set destinataires = Union(destinataires, Range("B63,B64,B65,B66"))
End If
End If
If MULTITECH Then
If destinataires Is Nothing Then
Set destinataires = Range("C63,C64,C65,C66")
Else
Set destinataires = Union(destinataires, Range("C63,C64,C65,C66"))
End If
End If
sujet = " Intervention EUROPE AVENUE "
message = "Bonjour" & " " & Range("CT44") & vbCrLf & vbCrLf & "Bienvenue sur les tests" & vbCrLf & vbCrLf & "SIGNATURE"
If destinataires Is Nothing Then
MsgBox "Aucun destinataire sélectionné - Pas d'envoi"
Exit Sub
End If
If destinataires.Count > 1 Then
adresses = destinataires.Value
Else
adresse = destinataires.Value
End If
'Assignation de l'application Outlook :
Set OutlookApp = CreateObject("outlook.application")
'Assignation des objets Outlook :
Set OutlookMail = OutlookApp.CreateItem(olMailItem)
'remplissage sujet et objet
OutlookMail.Subject = sujet
OutlookMail.Body = message
'remplissage destinaires
If destinataires.Count > 1 Then
For i_soc = 1 To UBound(adresses, 2)
For i_dest = 1 To UBound(adresses, 1)
Set dest_A = OutlookMail.Recipients.Add(adresses(i_dest, i_soc))
dest_A.Type = olTo
Next i_dest
Next i_soc
Else
OutlookMail.To = adresse
End If
'envoie le message
OutlookMail.Send
End If
End Sub
MIMOHUGUES
Messages postés
4
Date d'inscription
jeudi 12 mai 2016
Statut
Membre
Dernière intervention
19 mai 2016
>
thev
Messages postés
1882
Date d'inscription
lundi 7 avril 2008
Statut
Membre
Dernière intervention
26 octobre 2024
19 mai 2016 à 12:24
19 mai 2016 à 12:24
parfait ca marche !! :) merci bcp Thev vraiment !
13 mai 2016 à 12:24
Modifié par thev le 13/05/2016 à 12:29
13 mai 2016 à 12:33
Public Sub EnvoiAutomatiqueMail()
If MsgBox("Souhaitez-vous envoyer ce mail ?", vbQuestion + vbYesNo, "ENVOIE MAIL") = vbYes Then
Dim OutlookApp As Object
Dim OutlookMail As Object
Dim adresse As String
Dim message As String
Dim sujet As String
Dim ENGIE1 As String
Dim GRT1 As String
Dim TELMMA1 As String
Dim PCS1 As String
Dim MULTITECH1 As String
Dim IBM1 As String
If IBM Then
IBM1 = Range("D63,D64,D65,D66")
End If
If ENGIE Then
ENGIE1 = Range("E63,E64,E65,E66")
End If
If GRT Then
GRT1 = Range("F63,F64,F65,F66")
End If
If TELMMA Then
TELMMA1 = Range("A63,A64,A65,A66")
End If
If PCS Then
PCS1 = Range("B63,B64,B65,B66")
End If
If MULTITECH Then
MULTITECH1 = Range("C63,C64,C65,C66")
End If
sujet = " Intérvention EUROPE AVENUE "
message = "Boujour" & " " & Range("CT44") & vbCrLf & vbCrLf & "Bienvenue sur les tests" & vbCrLf & vbCrLf & "SIGNATURE"
adresse = IBM1 & ENGIE1 & GRT1 & TELMMA1 & PCS1 & MULTITECH1
With OutlookMail
'remplissage sujet et objet
OutlookMail.Subject = sujet
OutlookMail.To = adresse
OutlookMail.Body = message
'envoie le message
OutlookMail.Send
End With
End If
End Sub
mon problème est au niveau de "adresse", j'aimerais qu'il prenne les informations de toute les cellules que j'ai renseigné.