Outlook VBA to copy/duplicate a Meeting

CopyMeeting.bas

Sub Duplicate()
    Dim Item As Object
    
    Set Item = GetCurrentItem()
    If Item Is Nothing Then
        MsgBox "No Item selected"
        Exit Sub
    End If
    If Not TypeOf Item Is Outlook.AppointmentItem Then
        MsgBox "Selected item is not an appointment/meeting.", vbExclamation
        Exit Sub
    End If
    
    Dim appt As Outlook.AppointmentItem
    Set appt = Item.Copy
    
    If Not appt.ReminderSet Then
        appt.ReminderSet = True
        appt.ReminderMinutesBeforeStart = 15
    End If
    
    appt.Display
    
End Sub

GetCurrentItem.bas

Function GetCurrentItem() As Object
    Dim objApp As Outlook.Application
    Set objApp = Application
    On Error Resume Next
    Select Case TypeName(objApp.ActiveWindow)
        Case "Explorer"
            Set GetCurrentItem = objApp.ActiveExplorer.Selection.Item(1)
        Case "Inspector"
            Set GetCurrentItem = objApp.ActiveInspector.CurrentItem
    End Select
    
    Set objApp = Nothing
End Function

See related blog post: https://tdalon.blogspot.com/2024/11/outlook-blocks-meeting-copy.html