修改MS Project宏：导出任务至Outlook非默认日历遇错求助

问题分析 #

你遇到的两个错误原因如下：

1. 编译错误（For without next）：代码结构混乱，For Each myTask循环未添加对应的Next语句，且错误将Outlook日历查找逻辑嵌套在With myItem块内，导致语法结构无效。
2. 运行时错误（8004010f）：无法定位指定的非默认日历，核心原因是原代码的日历路径定位逻辑不准确，或名称匹配存在隐性问题（如首尾空格、大小写差异）。

修正后的完整代码 #

Option Explicit

Sub ExportTasksToNonDefaultOutlookCalendar()
    Dim myTask As Task
    Dim myOLApp As Object
    Dim myDefaultStore As Object
    Dim nonDefaultCalendar As Object
    Dim myItem As Object
    
    ' 初始化Outlook应用：优先获取已运行的实例，避免重复启动
    On Error Resume Next
    Set myOLApp = GetObject(, "Outlook.Application")
    If myOLApp Is Nothing Then
        Set myOLApp = CreateObject("Outlook.Application")
    End If
    On Error GoTo 0
    
    ' 检查Outlook初始化是否成功
    If myOLApp Is Nothing Then
        MsgBox "无法初始化Outlook应用程序。", vbCritical
        Exit Sub
    End If
    
    ' 定位非默认日历：通过默认日历的父文件夹查找，路径更可靠
    On Error Resume Next
    Set myDefaultStore = myOLApp.Session.DefaultStore
    ' 替换为你的实际日历名称，注意大小写和空格完全匹配
    Set nonDefaultCalendar = myDefaultStore.GetDefaultFolder(9).Parent.Folders("B2A Projects Calendar")
    On Error GoTo 0
    
    ' 检查日历是否找到
    If nonDefaultCalendar Is Nothing Then
        MsgBox "未找到指定日历，请检查名称后重试。", vbCritical
        Exit Sub
    End If
    
    ' 批量导出选中的任务到目标日历
    For Each myTask In ActiveSelection.Tasks
        Set myItem = nonDefaultCalendar.Items.Add(1) ' 1代表创建约会项
        With myItem
            .Start = myTask.Start
            .End = myTask.Finish
            .Subject = "Rangebank PS " & myTask.Name
            .Categories = myTask.Project
            .Body = myTask.Notes
            .Save ' 直接保存到目标日历，无需先存默认日历再移动
        End With
        Set myItem = Nothing ' 释放对象
    Next myTask
    
    MsgBox "任务导出完成！", vbInformation
End Sub

关键优化点 #

• 代码结构梳理：将Outlook初始化、日历定位逻辑移到循环外部，避免重复执行，同时修正语法嵌套错误。
• 可靠的日历定位：通过GetDefaultFolder(9)（对应Outlook的日历文件夹）的父文件夹查找目标日历，比直接通过Session.Folders定位更稳定，适配多数Outlook配置。
• 错误处理增强：在关键步骤添加错误捕获，明确提示问题，方便排查。
• 高效实例获取：优先获取已运行的Outlook实例，减少资源消耗。

额外排查建议 #

1. 确认日历名称：检查日历名称是否完全匹配，包括开头/结尾的空格、大小写（Outlook部分版本对名称大小写敏感）。
2. 子文件夹场景适配：如果目标日历在某个子文件夹下，修改路径为：

   Set nonDefaultCalendar = myDefaultStore.GetDefaultFolder(9).Parent.Folders("父文件夹名称").Folders("B2A Projects Calendar")
   

3. Outlook权限设置：确保Outlook允许宏运行，且信任中心设置允许Project访问Outlook对象模型。

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