Excel VBA无法在Outlook非默认日历创建约会问题求助

核心问题原因 #

你当前用OutApp.CreateItem(olAppointmentItem)创建约会，这个方法默认会把约会放到默认日历里，和你之前获取的fldCalendar对象没有关联，所以不管怎么指定文件夹ID或子文件夹，都不会生效。

修正后的代码 #

把创建约会的方式改成从目标日历文件夹的Items集合中添加，而不是用全局的CreateItem。完整修正后的代码如下：

Sub Create_Appt_For_WinderJob()
    ActiveSheet.Cells(ActiveCell.Row, 1).Select

    ' 指定目标子日历"Winder_Related"
    Dim OutApp As Outlook.Application
    Dim nmsNameSpace As Outlook.Namespace
    Dim fldCalendar As Outlook.MAPIFolder
    Dim OutAppoint As Outlook.AppointmentItem
    Dim ItemsCal As Outlook.Items
    Dim SC As Range

    Set OutApp = Outlook.Application
    Set nmsNameSpace = OutApp.GetNamespace("MAPI")
    ' 获取默认日历下的Winder_Related子文件夹
    Set fldCalendar = nmsNameSpace.GetDefaultFolder(olFolderCalendar).Folders("Winder_Related")
    
    ' 关键修改：从目标文件夹的Items集合创建约会，而不是用CreateItem
    Set OutAppoint = fldCalendar.Items.Add(olAppointmentItem)

    Set SC = ActiveCell

    ' 以下保留你原本填充约会字段的代码即可
    ' 示例（根据你的需求替换）：
    ' OutAppoint.Subject = SC.Offset(0, 1).Value
    ' OutAppoint.Start = SC.Offset(0, 2).Value
    ' OutAppoint.End = SC.Offset(0, 3).Value
    ' OutAppoint.Save ' 记得保存约会
End Sub

额外注意事项 #

• 确保子日历名称"Winder_Related"拼写完全一致（包括大小写、空格），Outlook对文件夹名称区分大小写。
• 如果你的默认日历属于某个非默认邮箱账户，需要先指定对应的账户文件夹，比如：

  ' 假设目标账户是第一个邮箱
  Set fldCalendar = nmsNameSpace.Folders("你的邮箱地址").Folders("日历").Folders("Winder_Related")
  

• 最后一定要调用OutAppoint.Save来保存约会到指定日历。

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