Ik heb me de laatste tijd helemaal suf gezocht en kom er maar niet uit. Kan iemand mij vertellen waarom ik de afspraak wel in mijn eigen agenda krijg (wanneer ik de code weer aanpas), maar niet in een shared agenda?
Alvast bedankt!
Alvast bedankt!
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
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
| Sub MakeAppts()
Dim olApp As Outlook.Application
Dim olAppt As Outlook.AppointmentItem
Dim olFldr As Outlook.MAPIFolder
Set olApp = New Outlook.Application
Dim cel As Object
Dim Response As Integer
' Ja en Nee Message box
Response = MsgBox(prompt:="Wilt u de planning kopieëren naar uw Outlook agenda.", Buttons:=vbYesNo)
' Wanneer Ja, dan afspraken inplannen.
If Response = vbYes Then
GoTo Volgende
Else
' Wanneer Nee, dan.
GoTo Einde
End If
Volgende:
Set olApp = New Outlook.Application
Set olFldr = olApp.GetNamespace("MAPI").Folders("Personal Folders") _
.Folders("ServicedeskICT")
Set olAppt = olFldr.Items.Add
' weg vanwege non-default folder
Set olApt = olApp.CreateItem(olAppointmentItem)
Call CollectSchedule
For Each cel In Intersect(Sheets("Blad1").UsedRange, Sheets("Blad1").[a2:a65536]).Cells
If cel.Value <> "" Then
Set olAppt = olApp.CreateItem(1)
With olAppt
.Start = cel
.Duration = cel.Offset(0, 1)
.Subject = cel.Offset(0, 2)
.Location = cel.Offset(0, 3)
.ReminderSet = False
.Save
End With
End If
Next
' Clean up...
Set olNs = Nothing
Set olAppt = Nothing
Set olItem = Nothing
Set olApp = Nothing
Einde:
MsgBox "Afspraken zijn ingepland!", vbEclamation, "Afspraak is ingepland"
End Sub |
