如何通过Excel VBA获得Outlook约会，而没有重复的主约会？

Sub CreateOutlookAppointment()
    Dim olApp As Outlook.Application
    Dim olApt As Outlook.AppointmentItem
    Dim olFolder As Outlook.Folder
    Dim olItems As Outlook.Items
    Dim olItem As Object
    Dim strSubject As String
    Dim dtStart As Date
    Dim dtEnd As Date
    Dim blnDuplicate As Boolean
    
    ' 设置约会的主题、开始时间和结束时间
    strSubject = "约会主题"
    dtStart = #开始时间#
    dtEnd = #结束时间#
    
    ' 创建Outlook应用程序对象
    Set olApp = New Outlook.Application
    
    ' 获取默认的约会文件夹
    Set olFolder = olApp.Session.GetDefaultFolder(olFolderCalendar)
    
    ' 获取约会文件夹中的所有约会项
    Set olItems = olFolder.Items
    
    ' 遍历所有约会项，检查是否存在重复的主约会
    For Each olItem In olItems
        If TypeOf olItem Is Outlook.AppointmentItem Then
            If olItem.Subject = strSubject And olItem.Start = dtStart And olItem.End = dtEnd Then
                blnDuplicate = True
                Exit For
            End If
        End If
    Next olItem
    
    ' 如果不存在重复的主约会，则创建新的约会项
    If Not blnDuplicate Then
        Set olApt = olApp.CreateItem(olAppointmentItem)
        With olApt
            .Subject = strSubject
            .Start = dtStart
            .End = dtEnd
            .Save
        End With
        MsgBox "成功创建Outlook约会。"
    Else
        MsgBox "已存在重复的主约会。"
    End If
    
    ' 释放对象
    Set olApt = Nothing
    Set olItems = Nothing
    Set olFolder = Nothing
    Set olApp = Nothing
End Sub