Outlook afspraak vanuit Excel persoonlijk maken in macro

Sub CreateAppointment()

    Application.EnableCancelKey = xlDisabled
    
    Set olOutlook = CreateObject("Outlook.Application")
    Set Namespace = olOutlook.GetNameSpace("MAPI")
    Set oloFolder = Namespace.GetDefaultFolder(9)
       
    selectedCell = ActiveCell + 1
    selectedRow = ActiveCell.Row
    selectedColumn = ActiveCell.Column
    
        Description = Cells(selectedRow, 2) & "  " & Cells(1, selectedColumn)
        StartDate = Cells(selectedRow, ActiveCell.Column)
        BusyStatus = 0
        ReminderSet = False
        Sensitivity = 0
        Set Appointment = oloFolder.items.Add
                
        With Appointment
        
            .Start = StartDate
            .Subject = Description
            .Save
        
        End With
        
        ActiveCell.Interior.ColorIndex = 34
End Sub

Sub M_snb()
   with CreateObject("Outlook.Application").CreateItem(1)
     .subject = Cells(acivecell.row, 2) & "  " & Cells(1, activecell.Column)
     .Start = activecell.value
     .Save
  End With

  ActiveCell.Interior.ColorIndex = 34
End Sub