Bonjour,
J'ai créé un tableau excel récapitulant les événements clés de ma société.
J'aimerais que chaque événement saisi soit automatiquement enregistré sur Outlook dans l'agenda partagé de mon équipe (champs sujet/ date début et fin / et champ commentaires).
J'ai repris un modèle existant sur un tableau qui faisait à peu près le job, mais je n'arrive pas à ajouter les champs "détails" et suivant en commentaires. De plus, ça enregistre les événements dans MON calendrier. Comment puis-je faire pour paramétrer l'envoi vers notre calendrier partagé (qui s'appelle "ENT - Reseau interne")?
Voici le code que j'ai actuellement, et en PJ mon tableau.
Merci beaucoup pour votre aide !!

CLASSEUR dates.xlsx

Code : Sélectionner tout - Visualiser dans une fenêtre à part
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
35
36
37
38
39
40
Option Explicit
 
Sub NouveauRDV_Calendrier()
'nécéssite d'activer la référence Microsoft Outlook 10.0 Object Library
Dim myOlApp As New Outlook.Application
Dim MyItem As Outlook.AppointmentItem
Dim Cell As Range
Dim dLgC As Long, dLgR As Long
 
For Each Cell In Range("A8:A" & Range("A22").End(xlUp).Row)
Set MyItem = myOlApp.CreateItem(olAppointmentItem)
 
With MyItem
.MeetingStatus = olNonMeeting
.Subject = Cell
.Start = Cell.Offset(0, 2)
.AllDayEvent = True
.Location = Cell.Offset(0, 1)
.Save
End With
 
Set MyItem = Nothing
Next Cell
 
With Sheets("Feuil1")
dLgC = .Range("A65536").End(xlUp).Row
If dLgC = 7 Then MsgBox "Il n'y a pas de données à transférer dans la feuille Resultats": End
 
Range("A8:C" & dLgC).Copy
End With
 
With Sheets("Feuil2")
 
dLgR = .Range("A65536").End(xlUp).Row + 1
 
.Range("A" & dLgR).PasteSpecial Paste:=xlPasteValues
End With
Sheets("Feuil1").Range("A8:C22").ClearContents
Sheets("Feuil2").Select
End Sub