Hallo Spezialisten,

ich versuche folgendes Makro zum Laufen zu bekommen:

https://www.howto-outlook.com/howto/openapptcopy.htm

Sub OpenAppointmentCopy()

'=================================================================
'Description: Outlook macro to create a new appointment with
'             specific details of the currently selected
'             appointment and show it in a new window.
'
' author : Robert Sparnaaij
' version: 1.0
' website: https://www.howto-outlook.com/howto/openapptcopy.htm
'=================================================================

    Dim objOL As Outlook.Application
    Dim objSelection As Outlook.Selection
    Dim objItem As Object
    Set objOL = Outlook.Application
    Dim Result
    
    'Get the selected item
    Select Case TypeName(objOL.ActiveWindow)
        Case "Explorer"
            Set objSelection = objOL.ActiveExplorer.Selection
            If objSelection.count > 0 Then
                Set objItem = objSelection.Item(1)
            Else
                Result = MsgBox("No item selected. " & _
                            "Please make a selection first.", _
                            vbCritical, "OpenAppointmentCopy")
                Exit Sub
            End If
        
        Case "Inspector"
            Set objItem = objOL.ActiveInspector.CurrentItem
            
        Case Else
            Result = MsgBox("Unsupported Window type." & _
                        vbNewLine & "Please make a selection" & _
                        "in the Calendar or open an item first.", _
                        vbCritical, "OpenAppointmentCopy")
            Exit Sub
    End Select

    Dim olAppt As Outlook.AppointmentItem
    Dim olApptCopy As Outlook.AppointmentItem
    Set olApptCopy = Outlook.CreateItem(olAppointmentItem)
        
    'Copy the desired details to a new appointment item
    If objItem.Class = olAppointment Then
        Set olAppt = objItem
        
        With olApptCopy
            .Subject = olAppt.Subject
            .Location = olAppt.Location
            .Body = olAppt.Body
            .Categories = olAppt.Categories
            .AllDayEvent = olAppt.AllDayEvent
        End With
        
        'Display the copy
        olApptCopy.Display
    
    'Selected item isn't an appointment item
    Else
        Result = MsgBox("No appointment item selected. " & _
                    "Please make a selection first.", _
                    vbCritical, "OpenAppointmentCopy")
        Exit Sub
    End If
    
    'Clean up
    Set objOL = Nothing
    Set objItem = Nothing
    Set olAppt = Nothing
    Set olApptCopy = Nothing
    
End Sub

Wenn ein Termin über objOL.ActiveInspector ausgelesen wird (Case Inspector/Man steht im geöffneten Termin), sind alle Eigenschaften zum Auslesen verfügbar.

Wir der Termin aber über objOL.ActiveExplorer ausgelesen (Case Explorer/Man steht im Kalender mit markiertem Termin), dann funktionieren nur noch Subject und wenige weitere. Location, Body usw. können nicht ausgelesen werden, obwohl es doch eigentlich funktionieren müsste.

Das Makro bleibt dann immer im folgenden Abschnitt bei den fett markierten Stellen hängen:
 

        With olApptCopy
            .Subject = olAppt.Subject
            .Location = olAppt.Location
            .Body = olAppt.Body
            .Categories = olAppt.Categories
            .AllDayEvent = olAppt.AllDayEvent
        End With

Wär toll, wenn Ihr eine Lösung hättet.
Mir fällt nix mehr ein.

Danke im voraus für Eure Hilfe.

Viele Grüße

Andrea