添加从excel VBA到outlook约会的超链接

Sub CreateOutlookAppointment()
    Dim olApp As Object
    Dim olApt As Object
    Dim strSubject As String
    Dim dtStart As Date
    Dim dtEnd As Date
    Dim strLocation As String
    Dim strAttendees As String
    Dim strBody As String
    Dim strLink As String
    
    ' 设置约会的属性值
    strSubject = "会议主题"
    dtStart = Now + TimeValue("01:00:00")
    dtEnd = dtStart + TimeValue("02:00:00")
    strLocation = "会议地点"
    strAttendees = "参与人1; 参与人2"
    strBody = "会议内容"
    
    ' 创建Outlook应用对象
    Set olApp = CreateObject("Outlook.Application")
    
    ' 创建约会项
    Set olApt = olApp.CreateItem(1)
    
    ' 设置约会项的属性
    With olApt
        .Subject = strSubject
        .Start = dtStart
        .End = dtEnd
        .Location = strLocation
        .RequiredAttendees = strAttendees
        .Body = strBody
        .ReminderSet = True
        .ReminderMinutesBeforeStart = 15
        .Save
    End With
    
    ' 获取约会项的超链接
    strLink = "outlook:AppointmentItem/" & olApt.EntryID
    
    ' 在Excel中创建超链接
    ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:=strLink, TextToDisplay:="创建Outlook约会"
    
    ' 释放对象
    Set olApt = Nothing
    Set olApp = Nothing
End Sub