向共享日历添加约会时出现类型不匹配问题求助

嘿，我来帮你搞定这个共享日历添加约会的类型不匹配问题！你之前能成功给默认日历加约会，是因为GetDefaultFolder(olFolderCalendar)直接返回的是属于你自己的默认日历文件夹类型，但共享日历属于其他用户，不能用同样的方式获取——这就是你报错的核心原因。

下面给你两种靠谱的解决方案，根据你的实际情况选就行：

方法1：通过共享日历所有者的邮箱/姓名获取（推荐） #

这种方法最直接，只要你知道共享日历所有者的邮箱或显示名称，就能精准获取对应的共享日历：

Option Explicit
Sub AddAppointmentToSharedCalendar()
    Dim O As Outlook.Application
    Dim ONS As Outlook.Namespace
    Dim myCalendar As Outlook.Folder
    Dim myapt As Outlook.AppointmentItem
    Dim sharedOwner As Outlook.Recipient
    
    ' 初始化Outlook对象
    Set O = New Outlook.Application
    Set ONS = O.GetNamespace("MAPI")
    
    ' 创建共享日历所有者的收件人对象，替换成实际邮箱/姓名
    Set sharedOwner = ONS.CreateRecipient("shared_user@yourdomain.com")
    
    ' 解析收件人，确保Outlook能找到这个用户
    If sharedOwner.Resolved Then
        ' 获取该用户的共享默认日历
        Set myCalendar = ONS.GetSharedDefaultFolder(sharedOwner, olFolderCalendar)
    Else
        MsgBox "找不到共享日历所有者，请检查邮箱/姓名是否正确！"
        Exit Sub
    End If
    
    ' 创建并设置约会信息
    Set myapt = myCalendar.Items.Add(olAppointmentItem)
    With myapt
        .Subject = "共享日历测试约会"
        .Start = DateAdd("d", 1, Now) ' 明天这个时间
        .End = DateAdd("h", 1.5, .Start) ' 持续1.5小时
        .Body = "这是添加到共享日历的测试内容"
        .Save ' 保存约会到共享日历
    End With
    
    MsgBox "约会已成功添加到共享日历！"
    
    ' 释放对象，避免内存泄漏
    Set myapt = Nothing
    Set myCalendar = Nothing
    Set sharedOwner = Nothing
    Set ONS = Nothing
    Set O = Nothing
End Sub

关键说明： #

• CreateRecipient用来创建共享日历所有者的收件人对象，必须确保能被Outlook解析（Resolve返回True），否则说明用户信息有误。
• GetSharedDefaultFolder是专门用来获取其他用户共享默认文件夹的方法，指定olFolderCalendar就能拿到目标共享日历。

方法2：通过共享日历名称查找（适合已添加到导航栏的共享日历） #

如果共享日历已经显示在你的Outlook导航栏里，你可以通过遍历日历文件夹的方式找到它：

Option Explicit
Sub AddAppointmentToNamedSharedCalendar()
    Dim O As Outlook.Application
    Dim ONS As Outlook.Namespace
    Dim myCalendar As Outlook.Folder
    Dim myapt As Outlook.AppointmentItem
    Dim calFolder As Outlook.Folder
    Dim targetCalName As String
    
    targetCalName = "我的共享日历" ' 替换成你的共享日历名称
    
    Set O = New Outlook.Application
    Set ONS = O.GetNamespace("MAPI")
    
    ' 遍历所有日历文件夹（默认日历的父文件夹下就是所有日历）
    For Each calFolder In ONS.GetDefaultFolder(olFolderCalendar).Parent.Folders
        If calFolder.Name = targetCalName Then
            Set myCalendar = calFolder
            Exit For
        End If
    Next calFolder
    
    ' 检查是否找到目标日历
    If myCalendar Is Nothing Then
        MsgBox "找不到名为'" & targetCalName & "'的共享日历！"
        Exit Sub
    End If
    
    ' 创建约会（和方法1逻辑一致）
    Set myapt = myCalendar.Items.Add(olAppointmentItem)
    With myapt
        .Subject = "命名共享日历测试"
        .Start = Now + 2 ' 后天此时
        .End = Now + 2.5
        .Body = "通过名称查找添加的共享日历约会"
        .Save
    End With
    
    MsgBox "约会添加成功！"
    
    ' 释放对象
    Set myapt = Nothing
    Set myCalendar = Nothing
    Set calFolder = Nothing
    Set ONS = Nothing
    Set O = Nothing
End Sub

重要提醒： #

• 确保你对目标共享日历有编辑权限，否则即使拿到文件夹对象，保存约会时也会报错。
• 类型不匹配的核心原因是你尝试把非Outlook.Folder类型的对象赋值给myCalendar变量，所以一定要确保获取到的是有效的日历文件夹对象。

内容的提问来源于stack exchange，提问作者Lindy Newman