agenda item plaatsen in Icloud agenda ipv mijn.pst

Private Sub cmdAgenda_Click()

''DoCmd.RunCommand acCmdSaveRecord

If Me!AddedToOutlook = True Then
    MsgBox "Deze afspraak is al toegevoegd"
    Exit Sub
Else
    Dim outObj As Outlook.Application
    Dim outAppt As Outlook.AppointmentItem
    Set outObj = CreateObject("Outlook.Application")
    Set outAppt = outObj.CreateItem(olAppointmentItem)
    With outAppt
        .Start = Me!ApptDate & " " & Me!ApptTime
        .Duration = Me!ApptLength
        .Subject = Me!Appt
        '.Categories = "Groen"
         .Categories = Me!AppCategorieen
         If Not IsNull(Me!ApptNotes) Then .Body = Me!ApptNotes
    If Not IsNull(Me!ApptLocation) Then .Location = Me!ApptLocation
    If Me!ApptReminder Then
        .ReminderMinutesBeforeStart = Me!ReminderMinutes
        .ReminderSet = True
    End If
    .Save
    End With
End If


Set outObj = Nothing

Me!AddedToOutlook = True
''DoCmd.RunCommand acCmdSaveRecord
Me.Requery
MsgBox "Afspraak is toegevoegd !"

Exit Sub

AddAppt_Err:
MsgBox "Error " & Err.Number & vbCrLf & Err.Description
Exit Sub

End Sub
Private Sub Knop52_Click()
On Error GoTo Err_Knop52_Click

    Dim stDocName As String
    Dim stLinkCriteria As String

    stDocName = "frmStartOutlook"
    DoCmd.OpenForm stDocName, , , stLinkCriteria

Exit_Knop52_Click:
    Exit Sub

Err_Knop52_Click:
    MsgBox Err.Description
    Resume Exit_Knop52_Click
    
End Sub