Sub EnvoyerMail(Destinataires As String)
' Envoi du BàT par mail
' Thierry (XLD) - complètée JNP
' Dans VBA La référence à OutLook (Outil -> Références... -> MicroSoft OutLook 12.0 Object Library)
' doit être activée (12.0 pour 2007, 11.0 pour 2003, etc.)
Dim OLApplication As Outlook.Application, OLMail As Outlook.MailItem
Set OLApplication = CreateObject("Outlook.Application")
Set OLMail = OLApplication.CreateItem(OLMailItem)
With OLMail
.To = Destinataires ' Destinataire
' .CC = "[EMAIL="titi@titi.fr"]titi@titi.fr[/EMAIL]" ' Copie
' .BCC = "[EMAIL="tutu@tutu.fr"]tutu@tutu.fr[/EMAIL]" ' 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
Sub test()
Dim I As Integer, ListeMail As String
I = 8
While Cells(I, 4) <> ""
If Not Intersect(Cells(I, 4).SpecialCells(xlCellTypeVisible), Cells(I, 4)) Is Nothing Then
ListeMail = ListeMail & ";" & Cells(I, 4)
End If
I = I + 1
Wend
EnvoyerMail (ListeMail)
End Sub