heu, "les gars", je dois avoir un doublement de personnalité ! lol
un exemple
Option Explicit
Sub Convoquer_par_ICS()
' ===========
' paramétrage
Const col_date = 2 ' numéro des colonnes où se trouvent les informations
Const col_debut = 3
Const col_fin = 4
Const col_action = 5 ' servira de test (envoi fichier .ics si vide), sinon mémorise l'action
Const titre = "le titre ici"
Const texte = "le texte ici"
Const destinataire = "truc.machin@clown.fr" ' le(s) destinataire(s) de ces invitations
' fin paramétrage
' ===============
Dim messagerie As Object
Dim email As Object
Dim cel As Object
Dim chemin As String
chemin = Environ("temp")
Set messagerie = CreateObject("Outlook.Application")
With ActiveSheet
For Each cel In .Range("A2:" & "A" & .Range("A" & Application.Rows.Count).End(xlUp).Row)
If cel.Value <> "" And cel.Offset(0, -1 + col_action).Value = "" Then
If cel.Offset(0, -1 + col_date) < Now() Then
cel.Offset(0, -1 + col_action) = "date échue"
ElseIf cel.Offset(0, -1 + col_debut) = "" Or cel.Offset(0, -1 + col_fin) = "" Then
cel.Offset(0, -1 + col_action) = ""
Else
Close #1
Open chemin & "\invitation.ics" For Output As #1
Print #1, "BEGIN:VCALENDAR"
Print #1, "BEGIN:VEVENT"
Print #1, "DTSTART:" & Application.Text(cel.Offset(0, -1 + col_date), "YYYYMMDD") & "T" & Application.Text(cel.Offset(0, -1 + col_debut), "HHMMSS") ' & "Z"
Print #1, "DTSTAMP:" & Application.Text(Now(), "YYYYMMDD") & "T" & Application.Text(Now(), "HHMMSS") ' & "Z"
Print #1, "DTEND:" & Application.Text(cel.Offset(0, -1 + col_date), "YYYYMMDD") & "T" & Application.Text(cel.Offset(0, -1 + col_fin), "HHMMSS") ' & "Z"
Print #1, "LOCATION;ENCODING=QUOTED-PRINTABLE:" & cel.Value
Print #1, "UID:"
Print #1, "SUMMARY;ENCODING=QUOTED-PRINTABLE:" & titre
Print #1, "DESCRIPTION;ENCODING=QUOTED-PRINTABLE:" & texte
Print #1, "PRIORITY:3"
Print #1, "SEQUENCE:0"
Print #1, "BEGIN:VALARM"
Print #1, "TRIGGER:-PT30M"
Print #1, "ACTION:DISPLAY"
Print #1, "DESCRIPTION:Rappel " & titre
Print #1, "END:VALARM"
Print #1, "END:VEVENT"
Print #1, "END:VCALENDAR"
Close #1
Set email = messagerie.CreateItem(0)
With email
.To = destinataire
.Subject = titre
.body = texte
.Attachments.Add chemin & "\invitation.ics"
.display
End With
Set email = Nothing
cel.Offset(0, -1 + col_action).Value = "Mail préparé par " & Environ("UserName") & " le " & Application.Text(Now(), "DD/MM/YYYY HH:MM")
End If
End If
Cells(cel.Row + 1, 1).Select
Next cel
End With
Set messagerie = Nothing
On Error Resume Next
Kill chemin & "\invitation.ics"
End Sub