XL 2016 fichier ics

[CYRIL CAMPAS]

Bonjour à tous les Xlnautes !

ma journée commence par un os que je ne sais pas résoudre. J'ai créé (à l'aide d'un super tuto) une macro pour que mon excel me génère un rdv automatique dans Outlook en fonction d'un tableau.

problème : quand je clique sur le bouton de ma macro, il ne se passe rien, le fichier ics ne se génère pas....

voici le code :
Function deux(tps)
deux = Right("00" & tps, 2)
End Function

Sub RDV()

On Error GoTo Erreur
Dim fichier As String
Ligne = ActiveCell.Row
Range("A" & Ligne).Select
EQUIPE = ActiveCell.Offset(0, 2).Value
fichier = ThisWorkbook.Path & "\" & "EQUIPE" & "rdv.ics"
DT = Split(ActiveCell.Offset(0, 4).Value, "/")
DEBUT = ActiveCell.Offset(0, 17).Value 'nombre entre 0 et 1 pour aller de minuit à 24h
FIN = DEBUT + ActiveCell.Offset(0, 18).Value 'nombre entre 0 et 1 pour aller de minuit à 24h
DTSTART = DT(0) & DT(1) & DT(2) & "T" & deux(Hour(DEBUT)) & deux(Minute(DEBUT)) & "00"
DTEND = DT(0) & DT(1) & DT(2) & "T" & deux(Hour(FIN)) & deux(Minute(FIN)) & "00"
Set f = CreateObject("ADODB.Stream")
With f
.Charset = "utf-8"
.Open
.WriteText "BEGIN:VCALENDAR" & vbCrLf
.WriteText "VERSION:2.0" & vbCrLf
.WriteText "PRODID:-//EXCEL//FR" & vbCrLf
.WriteText "BEGIN:VEVENT" & vbCrLf
.WriteText "DTSTART:" & DTSTART & vbCrLf
.WriteText "DTEND:" & DTEND & vbCrLf
.WriteText "SUMMARY:" & ActiveCell.Offset(0, 1) & ActiveCell.Offset(0, 2) & vbCrLf
.WriteText "END:VEVENT" & vbCrLf
.WriteText "END:VCALENDAR"
.SaveToFile fichier, 2
.Close
End With
Exit Sub

Erreur:
MsgBox "il manque des données"



End Sub

quelqu'un aurait-il une idée ? merci par avance pour votre aide précieuse

 

[CYRIL CAMPAS]

alors en fait j'ai trouvé, mon fichier ics s'enregistre là où se trouve mon fichier excel, je viens de percuter, c'est grace à la ligne de code suivante :

fichier = ThisWorkbook.Path & "\" & "EQUIPE" & "rdv.ics"

mais je me rends compte que je préfèrerai l'envoyer directement à un destinataire défini dans une cellule de mon tableau, j'ai donc créé cette variable :

destinataire = ActiveCell.Offset(0, 7).Value [puisque le mail de mon destinataire se trouve 7 colonne après la première cellule]

Et dans la création de mon fichier ICS, j'ai rajouté la ligne ainsi :

With f
.Charset = "utf-8"
.Open
.WriteText "BEGIN:VCALENDAR" & vbCrLf
.WriteText "VERSION:2.0" & vbCrLf
.WriteText "PRODID:-//EXCEL//FR" & vbCrLf
.WriteText "BEGIN:VEVENT" & vbCrLf
.WriteText "DTSTART:" & DTSTART & vbCrLf
.WriteText "DTEND:" & DTEND & vbCrLf
.WriteText "SUMMARY:" & ActiveCell.Offset(0, 1) & ActiveCell.Offset(0, 2) & vbCrLf
.WriteText "END:VEVENT" & vbCrLf
.WriteText "END:VCALENDAR"
'.SaveToFile fichier, 2

[ .Send: destinataire ] mais ça ne fonctionne pas !

.Close
End With
Exit Sub

qu'en pensez-vous ?