Développement- Fichiers ICS et Calendrier – Partie 3
Série de 3 articles sur les fichiers ICS : (1) Définition; (2) Création et Partage; (3) Automatisation Excel > Outlook
Partie 3: Créer une Interface entre Excel et Outlook
Mon but : exporter la cellule Excel sélectionnée vers un rendez-vous Outlook pour éviter de devoir rentrer mes rendez-vous en double.
Pré requis :
Ce fichier Excel contenant un calendrier en mode colonne de mois et lignes de jours.
Ignorez l’anglais car peu importe la langue utilisée nous travaillerons avec les chiffres. Admettons donc :
- Cellule H1 contenant l’année (2022)
- Colone L et P – Ligne 1 : mois en chiffre
- Colone L et P – Lignes 2 à 32 : jour du mois en chiffres
- Les réunions toujours formattées en utilisant HH:MM Texte (Heure et Minutes sur 2 chiffres)
- Utilisation : sélectionner cellule M17 > appuyer sur générer > Outlook ouvert avec les champs pré remplis.
Pour effectuer cette action, il faut passer en mode « développeur » sur Excel : Cliquer sur ‘View’ et ‘Macro’ . Voici les macros utilisées.
----
Sub Export_ICS_Vers_Outlook()
Dim ICS_str As String
ICS_str = "BEGIN:VCALENDAR" & vbCrLf
ICS_str = ICS_str & "VERSION:2.0" & vbCrLf
ICS_str = ICS_str & "PRODID:-//68600.fr//iCal Event Maker" & vbCrLf
ICS_str = ICS_str & "CALSCALE:GREGORIAN" & vbCrLf
ICS_str = ICS_str & "BEGIN:VTIMEZONE" & vbCrLf
ICS_str = ICS_str & "TZID:Europe/Berlin" & vbCrLf
ICS_str = ICS_str & "BEGIN:STANDARD" & vbCrLf
ICS_str = ICS_str & "TZNAME:CET" & vbCrLf
ICS_str = ICS_str & "TZOFFSETFROM:+0200" & vbCrLf
ICS_str = ICS_str & "TZOFFSETTO:+0100" & vbCrLf
ICS_str = ICS_str & "DTSTART:19701025T030000" & vbCrLf
ICS_str = ICS_str & "RRULE:FREQ=YEARLY;BYMONTH=10;BYDAY=-1SU" & vbCrLf
ICS_str = ICS_str & "END:STANDARD" & vbCrLf
ICS_str = ICS_str & "BEGIN:DAYLIGHT" & vbCrLf
ICS_str = ICS_str & "TZNAME:CEST" & vbCrLf
ICS_str = ICS_str & "TZOFFSETFROM:+0100" & vbCrLf
ICS_str = ICS_str & "TZOFFSETTO:+0200" & vbCrLf
ICS_str = ICS_str & "DTSTART:19700329T020000" & vbCrLf
ICS_str = ICS_str & "RRULE:FREQ=YEARLY;BYMONTH=3;BYDAY=-1SU" & vbCrLf
ICS_str = ICS_str & "END:DAYLIGHT" & vbCrLf
ICS_str = ICS_str & "END:VTIMEZONE" & vbCrLf
ICS_str = ICS_str & "LAST-MODIFIED:20201011T015911Z" & vbCrLf
ICS_str = ICS_str & "TZURL:http://tzurl.org/zoneinfo-outlook/Europe/Berlin" & vbCrLf
ICS_str = ICS_str & "X-LIC-LOCATION:Europe/Berlin" & vbCrLf
ICS_str = ICS_str & "BEGIN:VEVENT" & vbCrLf
ICS_str = ICS_str & "ATTENDEE;CN=" & """" & "Papa" & """" & ";RSVP=TRUE:mailto:papi@gmail.com" & vbCrLf
ICS_str = ICS_str & "CLASS:PRIVATE" & vbCrLf
ICS_str = ICS_str & "CATEGORIES:Important" & vbCrLf
ICS_str = ICS_str & "DTSTAMP:20220823T131634Z" & vbCrLf
ICS_str = ICS_str & "UID:'D6D" & Int((100000000 * Rnd) + 1) & "'" & vbCrLf
ICS_str = ICS_str & "DTSTART;TZID=Europe/Berlin:MyDateStart" & vbCrLf
ICS_str = ICS_str & "DTEND;TZID=Europe/Berlin:MyDateEnd" & vbCrLf
ICS_str = ICS_str & "SUMMARY;LANGUAGE=en-us:MyTitle" & vbCrLf
ICS_str = ICS_str & "DESCRIPTION:MyDescription" & vbCrLf
ICS_str = ICS_str & "LOCATION:MyLocation" & vbCrLf
ICS_str = ICS_str & "TRANSP:OPAQUE" & vbCrLf
ICS_str = ICS_str & "X-MICROSOFT-CDO-BUSYSTATUS:FREE" & vbCrLf
ICS_str = ICS_str & "BEGIN:VALARM" & vbCrLf
ICS_str = ICS_str & "ACTION:DISPLAY" & vbCrLf
ICS_str = ICS_str & "DESCRIPTION:Reminder" & vbCrLf
ICS_str = ICS_str & "TRIGGER:-PT15M" & vbCrLf
ICS_str = ICS_str & "END:VALARM" & vbCrLf
ICS_str = ICS_str & "END:VEVENT" & vbCrLf
ICS_str = ICS_str & "END:VCALENDAR" & vbCrLf
'MsgBox ICS_str
MyRow = ActiveCell.Row
MyCol = ActiveCell.Column
MeetDay = 0
MeetMonth = 1
MeetTime = 18 'Default Meeting Time
MeetText = ActiveCell.Value 'Default Meeting Text
If (Len(ActiveCell.Value) > 2) Then 'If more than digits then we run the rest
If (Left(ActiveCell.Value, 2) < 24) Then 'If 2 digits then it is a valid info for time
MeetTime = Left(MeetText, 2) 'Extract new Meeting Time
MeetText = Right(MeetText, Len(MeetText) - 3) 'Extract new Meeting Text
If (Left(MeetText, 2) < 60) Then
MeetTime = MeetTime & Left(MeetText, 2)
MeetText = Right(MeetText, Len(MeetText) - 3)
End If
If Len(MeetTime > 3) Then
MeetTime = MeetTime & "00"
Else
MeetTime = MeetTime & "0000"
End If
End If
'MsgBox (MeetTime)
If Len(MeetTime < 3) Then MeetTime = MeetTime & "00" 'Complement to have Time on 6 digits (HHMMSS)
ActiveCell.Offset(0, -1).Select 'Select Day date in left column
While MeetDay = 0
If (ActiveCell.Value > 0 And ActiveCell.Value < 32) Then
MeetDay = ActiveCell.Value
Else
ActiveCell.Offset(0, -1).Select 'Else Select Day date in one more left column
If (ActiveCell.Value > 0 And ActiveCell.Value < 32) Then
MeetDay = ActiveCell.Value
End If
'MsgBox ActiveCell.Value & " " & ActiveCell.Row & " " & ActiveCell.Column
End If
If (MeetDay < 10) Then MeetDay = "0" & MeetDay
Wend
ActiveCell.Offset((1 - ActiveCell.Row), 0).Select 'Select Month date in top row same column
MeetMonth = ActiveCell.Value
If (MeetMonth < 10) Then MeetMonth = "0" & MeetMonth
Range("J1").Select 'Select Year date in top row same column
MeetYear = ActiveCell.Value
ICS_str = Replace(ICS_str, "MyDescription", MeetText)
ICS_str = Replace(ICS_str, "MyTitle", MeetText)
ICS_str = Replace(ICS_str, "MyLocation", "Volgelsheim")
'20221006T100000
ICS_str = Replace(ICS_str, "MyDateStart", MeetYear & MeetMonth & MeetDay & "T" & MeetTime & "00")
ICS_str = Replace(ICS_str, "MyDateEnd", MeetYear & MeetMonth & MeetDay & "T" & MeetTime & "10")
Range(Cells(MyRow, MyCol), Cells(MyRow, MyCol)).Select
ICS_Filename = MeetYear & MeetMonth & MeetDay & "_" & Replace(MeetText, " ", "_") & ".ics"
lg = Ecrire_Txt(ActiveWorkbook.Path & "\" & ICS_Filename, ICS_str)
Call convertTxttoUTF(ActiveWorkbook.Path & "\" & ICS_Filename, ActiveWorkbook.Path & "\" & "UTF" & ICS_Filename)
'MsgBox "Export vers .ics = Ok"
If lg = 0 Then Shell ("C:\Program Files\Microsoft Office\root\Office16\OUTLOOK.EXE" & " /ical " & ActiveWorkbook.Path & "\" & "UTF" & ICS_Filename)
'/ical <icsfilename>
End If
End Sub
Enregister la macro, repartir sur une cellule du tableau Excel et essayer.
Note : Le fichier ICS et fichier ICS format UTF seront sauvegardés dans le meme dossier que fichier Excel utilisé.
Note 2: La durée n’étant pas spécifiée dans le calendrier Excel, la réunion aura une durée d’une seconde; c’est arbitraire et il me suffit de changer cela dans Outlook quand tout le reste sera déjà en place !
Étape finale, ajouter un moyen de lancement facile (plutot que naviguer dans les menus) : ajouter un bouton :
- Passez en mode développeur
- Sous l’onglet Fichier , accédez à Options > Personnaliser le ruban.
- Sous Personnaliser le ruban et Onglets principaux, activez la case à cocher Développeur.
- Sélectionnez le menu développeur, insérer > bouton
- Dessinez la taille et position du bouton (un gros rectangle )
- Définissez la macro « Export_ICS_Vers_Outlook »qui lui sera affecté.
Bilan
Comme pour la version HTML ou plutot PHP, j’ai adapté les champs à mon besoin, réunion privée, en mode important, avec rappel et qui ne bloque pas mon calendrier, envoi de l’invitation par courriel à un contact.
Cela conclue cette aventure un peu poilue dans le monde des fichier iCalendar, totalement hors sujet de D6D mais tout de même proche de l’automatisation 😉