[XL-2013] Générer des rendez-vous sur outlook à partir d'un fichier excel

1 pièce(s) jointe(s)

Générer des rendez-vous sur outlook à partir d'un fichier excel

Bonjour,

j'ai mis en place un fichier excel 365 avec une macro qui permet de générer des rendez-vous sur Outlook, mais je n'arrive pas à insérer les rendez-vous dans un sous-calendrier du calendrier par défaut.

Quelqu'un a-t-il une solution ?

Merci d'avance

Salut, dans la FAQ j'ai trouvé 1 et 2, en espérant que cela puisse faire avancer la chose.

Il y a aussi cette recherche sur le site, mais cela tu as dû le faire ?

code de la macro

en fait seule la ligne :

Code:

Set MyCalendar = myOlApp.GetNamespace("MAPI").Folders.Item(1).Folders.Item(5).Folders.Item(1).Item

ne fonctionne pas.

je reçois le message "indice hors de la matrice" et quand je le remplace par

Code:

Set MyCalendar = myOlApp.GetNamespace("MAPI").Folders.Item(1).Folders.Item(1).Folders.Item(1).Item

cela me créé le rv dans le calendrier principal
je ne peux modifier que le paramètre du 3eme dossier mais cela ne change pas le calendrier de destination.
exemple:

Code:

Set MyCalendar = myOlApp.GetNamespace("MAPI").Folders.Item(1).Folders.Item(1).Folders.Item(3).Item

le code est ci-dessous:

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
Private Sub calendrier_Click()
 Dim DateDebut As String
 Dim OutlItems As Outlook.Items
 Dim OutlAppointment As Outlook.AppointmentItem
 Dim myOlApp As New Outlook.Application
 Dim MyCalendar As Outlook.Items
 Dim MyItem As Outlook.AppointmentItem
 Dim myNamespace As Outlook.Namespace
 Dim Cell As Range
 Dim cal As String
 
 
        Set myOlApp = CreateObject("Outlook.Application")
'Concernant la ligne suivante après le ("MAPI")
'     Folders.Item(1) : correspond au dossier Personnel
'     Folders.Item(5) : correspond au dossier Calendrier standard
'     Folders.Item(1) : correspond au sous calendrier, s'il y en a d'autre remplacer par le n° d'index...
Set MyCalendar = myOlApp.GetNamespace("MAPI").Folders.Item(1).Folders.Item(5).Folders.Item(1).Item
 
         Set MyItem = myOlApp.CreateItem(olAppointmentItem)
         With MyItem 'inscription des données dans outlook
         .MeetingStatus = olNonMeeting 'meeting
         .ReminderSet = False ' S'il y a un rappel
         .Subject = Cells(4, 2)
         .Start = Cells(4, 1)
         .AllDayEvent = True ' Toute la journée oui/non
         .Location = "marseille"
         .Body = ""
         .Save
         End With
         Set MyItem = Nothing
 
 
 End Sub

Bonne réception