Rappel Outlook à partir d'Excel

Le 21/02/2019 à 21:57

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 !!!

99test.xlsx (11.91 Ko)
Le 22/02/2019 à 00:24

Bonjour Boyoo974,

il y a un fichier exemple ici:

https://forum.excel-pratique.com/viewtopic.php?f=2&t=77069

Le 22/02/2019 à 00:43

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 ?

Le 22/02/2019 à 01:37

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.

142boyoo974-outlook-rappel.xlsm (29.55 Ko)
Le 22/02/2019 à 12:26

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

Le 22/02/2019 à 12:35

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"

Le 22/02/2019 à 15:09

re,

il faut activer la référence "Microsoft Outlook xx.x Library"

67boyoo974-outlook-rappel-ver2.xlsm (20.69 Ko)
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!

Le 22/02/2019 à 15:27

Ah et comment puis-je fais cela stp ?

Je ne parviens pas à rééditer le message :/

Le 22/02/2019 à 17:01
Boyoo974 a écrit :

Ah et comment puis-je fais cela stp ?

vois-tu le bouton (style crayon) ?

editer message

est que ma dernière proposition fonctionne ?

Le 22/02/2019 à 17:19

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 ?

Le 22/02/2019 à 22:31

Elle fonctionne au top !!!!!

super!,

voici une version avec UF à tester,

51boyoo974-outlook-rappel-ver2.xlsm (30.96 Ko)
Le 22/02/2019 à 23:26

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 )

sans titre
Le 23/02/2019 à 00:04

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
Le 23/02/2019 à 00:26

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
Le 23/02/2019 à 00:36

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
Le 23/02/2019 à 01:15

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 23/02/2019 à 01:19
i20100 a écrit :

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

Le 23/02/2019 à 01:20

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)

Le 23/02/2019 à 01:25

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
Le 23/02/2019 à 02:00

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

Rechercher des sujets similaires à "rappel outlook partir"