Code envoie de mail a conditions
Bonjour,
Je suis a la recherche d'une aide precieuse !
Je n'arrive pas a faire fonctionner ma macro d'envoi de mail a condition.
Je dispose d'un fichier dispose de cette maniere
A: Yes (donc envoie de mail)
B: nom du destinataire
G: adresses mail
H: emplacement de la PJ
C2: Objet
C5: Corps du mail
B3: Date
Le but est que pour toutes les lignes avec "yes" encolonne A, le mail se creer avec un destinataire specifique et une PJ specifique.
Le soucis que j'ai c'est que mon For Each ne fonctionne pas et fait beuguer mon code.
Si qqun a deja eu ce genre de probleme, faites moi signe !
PS: Desole pour le manque d'accent, clavier QWERTY oblige !
K1000
Sub ExempleNewMail()
Dim appOutlook As Outlook.Application
Set appOutlook = Outlook.Application
Dim MESSAGE As Outlook.MailItem
Dim objRecipient As Outlook.Recipient
On Error GoTo cleanup
For Each cell In Columns("G").Cells.SpecialCells(xlCellTypeConstants)
If cell.Value Like "?*@?*.?*" And _
LCase(Cells(cell.Row, "A").Value) = "yes" Then
Set MESSAGE = appOutlook.CreateItem(olMailItem)
With MESSAGE
.Subject = Range("C2")
.BodyFormat = olFormatPlain
.Body = Range("C5")
Set objRecipient = .Recipients.Add(Range("G"))
objRecipient.Type = olTo
objRecipient.Resolve
Set objRecipient = .Recipients.Add("toto@titi")
objRecipient.Type = olCC
objRecipient.Resolve
'Ajout PJ
Dim MaPJ
MaPJ = Range("H")
If Dir(MaPJ) <> "" Then
.Attachments.Add MaPJ
End If
.ReadReceiptRequested = True
.Display
'envoi
'.Send
End With
On Error GoTo 0
Set MESSAGE = Nothing
End Sub
Ci-joint mon fichier
ET AUSSI!
L'erreur se trouve dans cette partie de mon code, autrement cela fonctionne mais uniquement pour mon premier destinataire
On Error GoTo cleanup
For Each cell In Columns("G").Cells.SpecialCells(xlCellTypeConstants)
If cell.Value Like "?*@?*.?*" And _
LCase(Cells(cell.Row, "A").Value) = "yes" Then
Un exemple qui fonctionne ci-joint.
Attention en fonction de ta version d'office il faudra recharger la version de ta librairie outlook correspondante. (Dans Visual Basic --> "Tools --> reference" si jamais tu vois "MANQUANT: Microsoft Outlook 16.0 Object Library" il faut le décocher et aller cocher manuellement dans la liste "Microsoft Outlook x.x Object Library"