Création de rendez-vous Outlook 2016 à partir de Excel2010 Résolu/Fermé

Question

Bonjour,

J'utilise un tableau excel pour faire le suivi de plusieurs étapes de la préparation des formations de mon département. Pour en faciliter le suivi j'aimerais pouvoir transférer les dates importantes dans mon calendrier outlook.

En cherchant sur les forums j'ai trouvé un code que je suis parvenue à adapter pour que la bonne information se transfère, mais pour un seul événement. J'aimerais bien que cela puisse se faire pour l'ensemble d'entre eux.

Voici le code que j'ai pour le moment:

#
Sub NouveauRDV_Calendrier()
'Nécessite d'activer la référence "Microsoft Outlook xx.x Object Library"
Dim OkApp As New Outlook.Application
Dim Rdv As Outlook.AppointmentItem

Set Rdv = OkApp.CreateItem(olAppointmentItem)

With Rdv
.MeetingStatus = olMeeting
.Subject = Range("a2")
.Body = "préparer liste de présence et cahiers des participants"
.Location = Range("e2")
.Start = Range("c2")
.Categories = "préparation outils"
.ReminderMinutesBeforeStart = 2880
.AllDayEvent = True
.ReminderSet = True
.Save
End With

Set OkApp = Nothing
End Sub
#

Merci beaucoup de votre aide
A

gbinforme · Accepted Answer

Bonjour, 

J'aimerais bien que cela puisse se faire pour l'ensemble d'entre eux
comme ceci cela devrait te le permettre :
Sub NouveauRDV_Calendrier()
'Nécessite d'activer la référence "Microsoft Outlook xx.x Object Library"
Dim OkApp As New Outlook.Application
Dim Rdv As Outlook.AppointmentItem
Dim lig As Long
Set Rdv = OkApp.CreateItem(olAppointmentItem)

With Rdv
    For lig = 2 To Cells(Rows.Count, 1).End(xlUp).Row
        .MeetingStatus = olMeeting
        .Subject = Range("A" & lig)
        .Body = "préparer liste de présence et cahiers des participants"
        .Location = Range("E" & lig)
        .Start = Range("C" & lig)
        .Categories = "préparation outils"
        .ReminderMinutesBeforeStart = 2880
        .AllDayEvent = True
        .ReminderSet = True
        .Save
    Next lig
End With

Set OkApp = Nothing
End Sub

gbinforme · Answer

Bonjour, 

sans avoir à le repasser au complet et donc créer des doublons 
Pour cela, je te propose de mémoriser le transfert en colonne G.
Si tu l'utilises pour autre chose tu mets une colonne libre.
Option Explicit

Sub NouveauRDV_Calendrier()
'Nécessite d'activer la référence "Microsoft Outlook xx.x Object Library"
Dim OkApp As New Outlook.Application
Dim Rdv As Outlook.AppointmentItem
Dim jrs As Byte, njr As Byte
Dim lig As Long, nbt As Integer
Set Rdv = OkApp.CreateItem(olAppointmentItem)

With Rdv
    For lig = 2 To Cells(Rows.Count, 1).End(xlUp).Row
        If Range("G" & lig).Value = "" Then
            .MeetingStatus = olMeeting
            .Subject = Range("A" & lig)
            .Body = "préparer liste de présence et cahiers des participants"
            .Location = Range("E" & lig)
            .Start = Range("C" & lig)
            .Categories = "préparation outils"
            jrs = 0: njr = 0
            While njr < 3
               njr = njr + Application.NetworkDays(Range("C" & lig) - jrs, Range("C" & lig) - jrs, Range("fériés"))
               jrs = jrs + 1
            Wend
            .ReminderMinutesBeforeStart = (jrs - 1) * 1440
            .AllDayEvent = True
            .ReminderSet = True
            .Save
            nbt = nbt + 1
            Range("G" & lig).Value = "Enregistré" ' la colonne G mémorise les transferts
        End If
    Next lig
End With
If nbt Then MsgBox nbt & " transferts"
Set OkApp = Nothing
End Sub

Création de rendez-vous Outlook 2016 à partir de Excel2010

2 réponses

Discussions similaires