Macro to clone a calendar in Outlook

CloneCalendar.vbs

Sub CloneCalendarItem()
    Dim objApp As Outlook.Application
    Dim objSelection As Outlook.Selection
    Dim objItem As Object
    Dim objNewItem As Outlook.AppointmentItem
    
    Set objApp = Outlook.Application
    Set objSelection = objApp.ActiveExplorer.Selection
    
    If objSelection.Count > 0 Then
        Set objItem = objSelection.Item(1)
        
        If TypeOf objItem Is Outlook.AppointmentItem Then
            Set objNewItem = objApp.CreateItem(olAppointmentItem)
            
            With objNewItem
                .Subject = objItem.Subject
                .RequiredAttendees = objItem.RequiredAttendees
                .OptionalAttendees = objItem.OptionalAttendees
                .MeetingStatus = olMeeting ' Set the item as a meeting
                .Body = "" ' Empty body
                .Display
            End With
        Else
            MsgBox "Please select a calendar item.", vbExclamation
        End If
    Else
    MsgBox "Selected one item.", vbExclamation
    End If
End Sub