Sub envoyer_mail()
'
' envoyer_mail Macro
' envoyer mail de rappel lorsque la date de retour de la question est dépassée.
' CTRL+MAJ+E
'
' version 1
Dim Desinataire, CopieCarbonne, CopieCarbonneInvisible, Sujet, Corps As String
Sheets("questions").Select
For n = 1 To Sheets("questions").Range("K65536").End(xlUp).Row
If Sheets("questions").Range("K" & n).Value = "envoyer mail" Then
Destinataire = Sheets("questions").Range("L" & n).Value
CopieCarbonne = ""
CopieCarbonneInvisible = Sheets("questions").Range("L" & n).Value 'cellule l de la ligne active
Sujet = "Question écrite n° " & Sheets("questions").Range("A" & n).Value 'cellule a de la ligne active
Corps = Sheets("questions").Range("F" & n).Value 'cellule f de la ligne active
Set OutApp = CreateObject("Outlook.Application")
OutApp.Session.Logon
Set OutMail = OutApp.CreateItem(olMailItem)
On Error Resume Next
With OutMail
.to = Destinataire
.CC = CopieCarbonne
.CCI = CopieCarbonneInvisible ' cette version ne fonctionne pas
.BCC = CopieCarbonneInvisible ' cette version fonctionne
.Subject = Sujet
.HTMLBODY = Corps
.Save
End With
OutMail.Display
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
End If
Next n
' version 2
'Dim LIGNE As Integer, Desinataire, CopieCarbonne, CopieCarbonneInvisible, Sujet, Corps As String
' Cells.Find("Rappel").Offset(1, 0).Activate
'LIGNE = Cells(65536, ActiveCell.Column).End(xlUp).Row
'For i = 1 To LIGNE
' If ActiveCell = "envoyer mail" Then
' Destinataire = ""
' CopieCarbonne = ""
' CopieCacarbonneInvisible = "" 'cellule l de la ligne active
' Sujet = "Question écrite n° " & "" 'cellule a de la ligne active
' Corps = "" 'cellule f de la ligne active
' Set OutApp = CreateObject("Outlook.Application")
' OutApp.Session.Logon
' Set OutMail = OutApp.CreateItem(olMailItem)
' On Error Resume Next
' With OutMail
' .to = Destinataire
' .CC = CopieCarbonne
' .CCI = CopieCarbonneInvisible
' .Subject = Sujet
' .HTMLBODY = Corps
' .Save
' End With
'
' OutMail.Display
' On Error GoTo 0
' Set OutMail = Nothing
' Set OutApp = Nothing
' End If
' ActiveCell.Offset(1, 0).Select
' Next
End Sub