Rappel Outlook à partir d'Excel
Bonsoir à tous !
J'aimerai faire une macro me permettant de faire un rendez vous outlook (sans y inviter un contact) rapidement en étant sur Excel
L'idée est que lorsque j'exécute la macro sur la cellule d'une ligne. Elle utilise 3 éléments pour faire le rappel:
- La cellule de la colonne "Actions" en tant qu'"Objet"
- La cellule "Observations" en tant que Notes
- La celulle "Quand" comme Date du rendez vous
Mais je voudrais que lorsque j'exécute la macro, on me propose
- De fixer le nombre de jour avant la date du rendez vous pour fixer une alarme (si le rendez vous est le 20/02, je veux une alarme 2 jours avant par exemple)
- Et de fixer la durée du rendez vous
J'ai mis en PJ le modèle de fichier Excel que j'aimerai utiliser.
Je pense que je demande l'impossible, mais j'ai été surpris à plusieurs reprises par vos capacités à utiliser le potentiel d'Excel, donc je tente !
Merci à vous !!!
Bonjour Boyoo974,
il y a un fichier exemple ici:
Salut i20100,
Merci pour ta reponse
J'ai vu ce sujet avant de poster le mien, mais ce n'est pas vraiment la même chose
Toutes mes lignes ne sont pas à planifier, je voudrais que si j'exécute ma macro sur la cellule C3 alors il le fait un rdv Outlook de la ligne 3, pas de la feuille entière tu vois ?
Bonjour
j'ai fait un exemple à partir du fichier de Jimmy (sans les UF)
la macro s'exécute pour la ligne active uniquement.
il faudra modifier les données de la feuille Suivi.
J'ai essayé d'adapter le fichier à mes besoins mais en vain..
J'ai enlevé les Si car au final, si la macro s'exécute pour la ligne voulu, les SI ne sont plus utiles.
J'ai essayé d'adapter le sujet du rendez vous mais cela ne fonctionne plus ....
En revanche il n'est pas possible qu'à l'exécution de la macro, une fenetre s'ouvre pour me demande la durée du rdv et le rappel?
Sub AjoutRV()
Dim Lig As Long
Dim OutObj As Object, OutAppt As Object
Dim DateRdv As Date, FlgRdv As Boolean
Dim sFilter As String
Dim oAppointment As Outlook.AppointmentItem
Dim namespaceOutlook As Outlook.Namespace
Dim DossierCalendrier As Outlook.MAPIFolder
' Créer une instance d'Outlook
Set OutObj = CreateObject("outlook.application")
Set namespaceOutlook = OutObj.GetNamespace("MAPI")
Set DossierCalendrier = namespaceOutlook.GetDefaultFolder(olFolderCalendar)
' Avec la feuille
With Sheets("A FAIRE")
DateRdv = Range("G" & Lig)
Set OutAppt = OutObj.CreateItem(1)
sFilter = [Subject] = Sheets("A FAIRE").Range("B" & Lig) & " " & Sheets("A FAIRE").Range("C" & Lig) & "' "
Set oAppointment = DossierCalendrier.Items.Find(sFilter)
If Not oAppointment Is Nothing Then
With oAppointment
.Subject = Sheets("A FAIRE").Range("B" & Lig) & " " & Sheets("A FAIRE").Range("C" & Lig) & "' "
.Start = DateRdv & " 08:00"
.Duration = 60
.ReminderSet = True
.Save
End With
Else
With OutAppt
.Subject = Sheets("A FAIRE").Range("B" & Lig) & " " & Sheets("A FAIRE").Range("C" & Lig) & "' "
.Start = DateRdv & " 08:00"
.Duration = 60
.ReminderSet = True
.Save
End With
End If
' Créer le commentaire et inscrire Oui
On Error Resume Next
.Range("Q" & Lig).Comment.Delete
.Range("Q" & Lig).AddComment Text:=.Range("C" & Lig).Value
.Range("Q" & Lig) = "Oui"
On Error GoTo 0
End If
End With
Set OutAppt = Nothing
End Sub
En fait quand j'exécute la macro
il me surligne ce code "Dim oAppointment As Outlook.AppointmentItem"
et me dit "Erreur de compilation: Type défini par l'utilisation non défini"
re,
il faut activer la référence "Microsoft Outlook xx.x Library"
Sub AjoutRV()
'Nécessite d'activer la référence "Microsoft Outlook xx.x Library"
Dim sh As Worksheet
Dim Lig As Long, DateRdv As Date, sSubject As String, sStart As String, iDuration As Integer
Dim OutObj As Object, OutAppt As Object
Dim sFilter As String
Dim oAppointment As Outlook.AppointmentItem
Dim namespaceOutlook As Outlook.Namespace
Dim DossierCalendrier As Outlook.MAPIFolder
Set OutObj = CreateObject("outlook.application")
Set namespaceOutlook = OutObj.GetNamespace("MAPI")
Set DossierCalendrier = namespaceOutlook.GetDefaultFolder(olFolderCalendar)
Set sh = Sheets("A faire")
If ActiveCell.Row < 5 Then GoTo fin
If Cells(ActiveCell.Row, "B") = "" Then GoTo fin
If Cells(ActiveCell.Row, "G") = "" Then GoTo fin
With sh
Lig = ActiveCell.Row
DateRdv = Range("G" & Lig)
sSubject = "Rappeler " & sh.Range("B" & Lig)
sStart = DateRdv & " 10:00"
iDuration = 60
Set OutAppt = OutObj.CreateItem(1)
sFilter = "[Subject] = '" & sSubject & "' "
Set oAppointment = DossierCalendrier.Items.Find(sFilter)
If Not oAppointment Is Nothing Then
With oAppointment
.Subject = sSubject
.Start = sStart
.Duration = iDuration
.ReminderSet = True
.Save
End With
Else
With OutAppt
.Subject = sSubject
.Start = sStart
.Duration = iDuration
.ReminderSet = True
.Save
End With
End If
End With
Set OutAppt = Nothing
MsgBox "Le rappel a été créer"
Exit Sub
fin:
MsgBox "Le rappel n'a pas été créer"
End Sub
ps/ s.t.p. édite ton précédent message et met ton code entre balise, merci!
Ah et comment puis-je fais cela stp ?
Je ne parviens pas à rééditer le message :/
Elle fonctionne au top !!!!!
Merci bcp !
En revanche il n'est pas possible d'avoir une fenêtre qui s'ouvre en exécutant la macro pour demander la durée du rdv et la date du rappel du coup ?
Elle fonctionne au top !!!!!
super!,
voici une version avec UF à tester,
La fenetre s'ouvre effectivement, en revanche, la durée est en minutes et la date inscrite correspond à la date du RDV et non du rappel
En fait j'aurai aimé avoir une fenêtre avec ces paramètres la plutôt: (j'ai essayé de fouiller dans tes macros, mais là, cela dépasse largement mon domaine de compétence
J'ai finalement presque réussi!
Je suis passé par des input box, c'était plus simple à mon petit niveau
Par contre je n'arrive pas à paramétrer le Rappel le ReminderSet je suppose que j'aimerai faire fonctionner à l'aide d'une input box aussi !
Voilà le code actuel
Sub AjoutRV_test()
'Nécessite d'activer la référence "Microsoft Outlook xx.x Library"
Dim sh As Worksheet
Dim Lig As Long, DateRdv As Date, sSubject As String, sStart As String, iDuration As Integer
Dim OutObj As Object, OutAppt As Object
Dim sFilter As String
Dim oAppointment As Outlook.AppointmentItem
Dim namespaceOutlook As Outlook.Namespace
Dim DossierCalendrier As Outlook.MAPIFolder
Set OutObj = CreateObject("outlook.application")
Set namespaceOutlook = OutObj.GetNamespace("MAPI")
Set DossierCalendrier = namespaceOutlook.GetDefaultFolder(olFolderCalendar)
Set sh = Sheets("A faire")
If ActiveCell.Row < 5 Then GoTo fin
If Cells(ActiveCell.Row, "B") = "" Then GoTo fin
If Cells(ActiveCell.Row, "G") = "" Then GoTo fin
durée = InputBox("Saisir la durée du RDV ou de la tache (en minutes) : ")
début = InputBox("Saisir l'heure du RDV ou de la tache (format xx:xx) : ")
With sh
Lig = ActiveCell.Row
DateRdv = Range("G" & Lig)
sSubject = sh.Range("B" & Lig) & " " & sh.Range("C" & Lig)
sStart = DateRdv & " " & début
iDuration = durée
Set OutAppt = OutObj.CreateItem(1)
sFilter = "[Subject] = '" & sSubject & "' "
Set oAppointment = DossierCalendrier.Items.Find(sFilter)
If Not oAppointment Is Nothing Then
With oAppointment
.Subject = sSubject
.Start = sStart
.Duration = iDuration
.ReminderSet = True
.Save
End With
Else
With OutAppt
.Subject = sSubject
.Start = sStart
.Duration = iDuration
.ReminderSet = True
.Save
End With
End If
' Créer le commentaire et inscrire Oui
On Error Resume Next
.Range("D" & Lig).Comment.Delete
.Range("D" & Lig).AddComment Text:=.Range("D" & Lig).Value
.Range("D" & Lig) = "Oui"
On Error GoTo 0
End With
Set OutAppt = Nothing
MsgBox "Le rappel a été crée"
Exit Sub
fin:
MsgBox "Le rappel n'a pas été crée"
End Sub
re,
est ce que tu parles de combien de minutes avant le début du rendez-vous que le rappel doit se déclencher
.ReminderMinutesBeforeStart = 60
J'ai réussi à le faire
Par contre mon rendez vous doit être paramétré via les input box, il est possible de faire un paramétrage par défaut? C'est à dire que si je ne met rien dans mes input box, il me fixe l'heure à 8h00, la durée à 30 min et le rappel à 1h par exemple?
Voilà mon code
Sub AjoutRV()
'Nécessite d'activer la référence "Microsoft Outlook xx.x Library"
Dim sh As Worksheet
Dim Lig As Long, DateRdv As Date, sSubject As String, sStart As String, iDuration As Integer
Dim OutObj As Object, OutAppt As Object
Dim sFilter As String
Dim oAppointment As Outlook.AppointmentItem
Dim namespaceOutlook As Outlook.Namespace
Dim DossierCalendrier As Outlook.MAPIFolder
Set OutObj = CreateObject("outlook.application")
Set namespaceOutlook = OutObj.GetNamespace("MAPI")
Set DossierCalendrier = namespaceOutlook.GetDefaultFolder(olFolderCalendar)
Set sh = Sheets("A faire")
If ActiveCell.Row < 5 Then GoTo fin
If Cells(ActiveCell.Row, "B") = "" Then GoTo fin
If Cells(ActiveCell.Row, "G") = "" Then GoTo fin
durée = InputBox("Saisir la durée du RDV ou de la tache (en minutes) : ")
début = InputBox("Saisir l'heure du RDV ou de la tache (format hh:mm) : ")
Rappel = InputBox("Saisir le nombre de jour avant le RDV ou de la tache pour avoir le rappel : ")
With sh
Lig = ActiveCell.Row
DateRdv = Range("G" & Lig)
sSubject = sh.Range("B" & Lig) & " " & sh.Range("C" & Lig)
sStart = DateRdv & " " & début
iDuration = durée
Set OutAppt = OutObj.CreateItem(1)
sFilter = "[Subject] = '" & sSubject & "' "
Set oAppointment = DossierCalendrier.Items.Find(sFilter)
If Not oAppointment Is Nothing Then
With oAppointment
.Subject = sSubject
.Start = sStart
.Duration = iDuration
.ReminderMinutesBeforeStart = Rappel * 1440
.Save
End With
Else
With OutAppt
.Subject = sSubject
.Start = sStart
.Duration = iDuration
.ReminderMinutesBeforeStart = Rappel * 1440
.Save
End With
End If
' Créer le commentaire et inscrire Oui
On Error Resume Next
.Range("D" & Lig).Comment.Delete
.Range("D" & Lig).AddComment Text:=.Range("D" & Lig).Value
.Range("D" & Lig) = "Oui"
On Error GoTo 0
End With
Set OutAppt = Nothing
MsgBox "Le rappel a été crée"
Exit Sub
fin:
MsgBox "Le rappel n'a pas été crée"
End Sub
ok,
je vais essayé de démêler les variables
sStart = DateRdv & " " & début
date et heure ou le rappel va s'inscrire dans le calendrier Outlook
iDuration = durée
'l'espace que le rappel va occuper dans le calendrier Outlook par tranche de 30 min.
tempsAvant = InputBox("Saisir le nombre de minutes avant le début du rendez-vous que le rappel doit se déclencher(format x)
'par exemple:
'tempsAvant = 120 ( 2h avant) nombre de minutes avant le début du rendez-vous ou le rappel doit se déclencher
.ReminderMinutesBeforeStart = tempsAvant
ok,
je vais essayé de démêler les variables
sStart = DateRdv & " " & début
date et heure ou le rappel va s'inscrire dans le calendrier Outlook
iDuration = durée
'l'espace que le rappel va occuper dans le calendrier Outlook par tranche de 30 min.tempsAvant = InputBox("Saisir le nombre de minutes avant le début du rendez-vous que le rappel doit se déclencher(format x) 'par exemple: 'tempsAvant = 120 ( 2h avant) nombre de minutes avant le début du rendez-vous ou le rappel doit se déclencher .ReminderMinutesBeforeStart = tempsAvant
Le code sStart = DateRdv & " " & début
correspond simplement à l'heure du RDV, le rappel est paramétré via le ReminerMinutesBeforeStart
J'essaie de mettre des formules IF dans mon codage mais je ne sais pas trop y faire..
.Duration = IF iDuration = <> Then 10 Else iDuration
Je veux lui dire que si iDuration = rien alors 10 sinon on met La valeur de iDuration (défini dans la input box)
re,
If iDuration = "" Then
iDuration = 10
Else
iDuration = durée
End If
si c'est pour vérifier que le InputBox
n'est pas vide,
durée = InputBox("Saisir la durée du RDV ou de la tache (en minutes) : ")
If durée = "" Then
iDuration = 10
Else
iDuration = durée
End If
J'ai tenté de faire de même pour le l'heure du début du Rdv mais ca ne fonctionne pas...
Pour le rappel c'est curieux, la macro fonctionne une fois, par contre si je réexécute sur la même ligne (et tente donc de remplacer le RDV), la macro échoue au codage du rappel..
Sub AjoutRV()
'Nécessite d'activer la référence "Microsoft Outlook xx.x Library"
Dim sh As Worksheet
Dim Lig As Long, DateRdv As Date, sSubject As String, sStart As String, iDuration As Integer
Dim OutObj As Object, OutAppt As Object
Dim sFilter As String
Dim oAppointment As Outlook.AppointmentItem
Dim namespaceOutlook As Outlook.Namespace
Dim DossierCalendrier As Outlook.MAPIFolder
Set OutObj = CreateObject("outlook.application")
Set namespaceOutlook = OutObj.GetNamespace("MAPI")
Set DossierCalendrier = namespaceOutlook.GetDefaultFolder(olFolderCalendar)
Set sh = Sheets("A faire")
If ActiveCell.Row < 5 Then GoTo fin
If Cells(ActiveCell.Row, "B") = "" Then GoTo fin
If Cells(ActiveCell.Row, "G") = "" Then GoTo fin
'Durée du RDV
durée = InputBox("Saisir la durée du RDV ou de la tache (en minutes) : ")
If durée = "" Then
iDuration = 10
Else
iDuration = durée
End If
'Heure du Rdv
début = InputBox("Saisir l'heure du RDV ou de la tache (format hh:mm) : ")
'Rappel
Rappel = InputBox("Saisir le nombre de jour avant le RDV ou de la tache pour avoir le rappel : ")
With sh
Lig = ActiveCell.Row
DateRdv = Range("G" & Lig)
sSubject = sh.Range("B" & Lig) & " " & sh.Range("C" & Lig)
sStart = DateRdv & " " & début
Set OutAppt = OutObj.CreateItem(1)
sFilter = "[Subject] = '" & sSubject & "' "
Set oAppointment = DossierCalendrier.Items.Find(sFilter)
If Not oAppointment Is Nothing Then
With oAppointment
.Subject = sSubject
.Start = sStart
.Duration = iDuration
.ReminderMinutesBeforeStart = Rappel * 1440
If Rappel = "" Then
.ReminderMinutesBeforeStart = 60
Else
.ReminderMinutesBeforeStart = Rappel * 1440
End If
.Save
End With
Else
With OutAppt
.Subject = sSubject
.Start = sStart
.Duration = iDuration
If Rappel = "" Then
.ReminderMinutesBeforeStart = 60
Else
.ReminderMinutesBeforeStart = Rappel * 1440
End If
.Save
End With
End If
' Créer le commentaire et inscrire Oui
On Error Resume Next
.Range("D" & Lig).Comment.Delete
.Range("D" & Lig).AddComment Text:=.Range("D" & Lig).Value
.Range("D" & Lig) = "Oui"
On Error GoTo 0
End With
Set OutAppt = Nothing
MsgBox "Le rappel a été crée"
Exit Sub
fin:
MsgBox "Le rappel n'a pas été crée"
End Sub