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 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56
| Dim outlookApp As Outlook.Application
Dim myNamespace As Outlook.Namespace
Dim myRecipient As Outlook.Recipient
Dim CalendarFolder As Outlook.folder
Dim i As Long
Set outlookApp = New Outlook.Application
Set myNamespace = outlookApp.GetNamespace("MAPI")
Set myRecipient = myNamespace.CreateRecipient("dp-TECCR-FormationdesrepartiteursCCRediteurs@hydro.qc.ca")
i = 2
myRecipient.Resolve
Range("A1:D1").Value = Array("Subject", "from", "date", "location")
If myRecipient.Resolved Then
Set CalendarFolder = myNamespace.GetSharedDefaultFolder(myRecipient, olFolderCalendar)
' Set CalendarFolder = myNamespace.GetDefaultFolder(olFolderCalendar)
Dim CalendarItem As Outlook.AppointmentItem
For Each CalendarItem In CalendarFolder.Items
Cells(i, 1).Value = CalendarItem.Subject
Cells(i, 2).Value = CalendarItem.Start
Cells(i, 3).Value = CalendarItem.End
Cells(i, 4).Value = CalendarItem.Location
Cells(i, 5).Value = CalendarItem.MeetingStatus
i = i + 1
Next
End If
Set outlookApp = Nothing
Set myNamespace = Nothing
Set myRecipient = Nothing
Set CalendarFolder = Nothing
Set CalendarItem = Nothing |
Partager