Génération de rappel / RDV --> Cherche idée géniale

GADENSEB

XLDnaute Impliqué
Bonjour le Forum !


J'ai besoin de votre aide car je cherche une idée géniale ....

Je gére une bdd et j'ai besoin de générer des rappels et ou rdv ....


Jusqu’à la fin de l'année dernière, j'utilisé un code qui me créer un rdv sous mon google agenda en fonction de certains critères de ma bdd
--> Donc parfait !

Mais Google à abandonné ce code (passant de la V2 à la V3 du code) et bien sûr mon code ne fonctionne plus.

Comme je n'ais pas le temps, ni l'envie de recréer le code je cherche une solution alternative...


Donc le but du jeu est de me créer automatiquement des rappels/rdv


Mais je n'ais pas trop d'idées ( je ne souhaite pas utilisé outlook)


Si vos cerveaux géniaux ont l'inspiration ce matin ;-)

Bonne journée

Seb
 
Dernière édition:

kiki29

XLDnaute Barbatruc
Re : Génération de rappel / RDV --> Cherche idée géniale

Salut, le calendrier d'OutLook permet à priori tout cela.
Code:
Option Explicit

Private Function CreerRendezVous_02(PCalendrier As String, _
                            PDate As String, _
                            PHeure As String, _
                            PDuree As Integer, _
                            PSubject As String, _
                            PNotes As String, _
                            PLieu As String, _
                            Optional PMinutesRappel As Integer = 0)

    On Error GoTo Add_Err

    Dim objOutlook As Object
    Dim objAppt As Object
    Dim olns As Object
    Dim MycalendarFolder As Object
    Dim MyFolder As Object

    Set objOutlook = CreateObject("Outlook.Application")
    Set olns = objOutlook.GetNamespace("MAPI")
    Set MycalendarFolder = olns.GetDefaultFolder(olFolderCalendar)

    If PCalendrier = "" Then
        Set MyFolder = MycalendarFolder.Items
    Else
        Set MyFolder = MycalendarFolder.Folders(PCalendrier).Items
    End If
    Set objAppt = MyFolder.Add

    With objAppt
        If PDuree > 0 Then
            .Start = PDate & " " & PHeure
            .Duration = PDuree
        Else
            .Start = PDate
            .AllDayEvent = True
        End If
        .Subject = PSubject
        .Body = PNotes
        .Location = PLieu
        
        If PMinutesRappel > 0 Then
            .ReminderMinutesBeforeStart = PMinutesRappel
            .ReminderSet = True
        End If
        
        .Save
        .Close (olSave)
    End With
    
    Set objAppt = Nothing
    Set objOutlook = Nothing
    MsgBox "Rdv ajouté!"
    Exit Function

Add_Err:
    MsgBox "Error " & Err.Number & vbCrLf & Err.Description
End Function

'    PCalendrier : Le nom du calendrier concerné. Passez une chaîne vide pour utiliser le calendrier par défaut
'    PDate : La date du rendez vous.
'    PHeure:      L 'heure du rendez vous.
'    PDuree : La durée du rendez vous en minutes. Utilisez 0 pour que le rendez vous dure toute la journée.
'    PSubject:      L 'objet du rendez vous.
'    PNotes : Un court résumé du rendez vous.
'    PLieu : Le lieu du rendez vous.
'    PMinutesRappel : Le nombre de minutes avant un rappel.
'       Ne pas renseigner ce paramètre si vous ne souhaitez pas utiliser le rappel Outlook.

Sub tst()
    CreerRendezVous "", Date, _
                    "14:30", 53, "Test", "Ceci est un test", _
                    "Gare de l'Est", 5
End Sub
 

Statistiques des forums

Discussions
312 504
Messages
2 089 073
Membres
104 019
dernier inscrit
pascal la