将 MS Project 任务发送到不同的 Outlook 日历而不是我的默认日历

Question

此代码将 MS Project 任务作为事件发送到 Outlook。

我想将其设置为不同的日历而不是我的默认日历。

原代码：

Sub Export_Selection_To_OL_Appointments()
Dim myTask As Task
Dim myItem As Object
    
On Error Resume Next
Set myOLApp = CreateObject("Outlook.Application")
  
For Each myTask In ActiveSelection.Tasks
    Set myItem = myOLApp.CreateItem(1)
    With myItem
        .Start = myTask.Start
        .End = myTask.Finish
        .Subject = " Rangebank PS " & myTask.Name
        .Categories = myTask.Project
        .Body = myTask.Notes
        .Save
    End With
Next myTask

End Sub

尝试了我在网上找到的代码。

Answer 1

这演示了如何引用非默认 Outlook 文件夹来添加项目。

Option Explicit

Sub NonDefaultFolder_Add_Not_Create()

Dim myOlApp As Object
Dim myDefaultStore As Object

Dim nonDefaultCalendar As Object
Dim myItem As Object

On Error Resume Next
Set myOlApp = CreateObject("Outlook.Application")

' Consider this mandatory.
' Limit the scope of the error bypass to the minimum number of lines.
' Ideally the scope is zero lines.
On Error GoTo 0

If Not myOlApp Is Nothing Then

    Set myDefaultStore = myOlApp.Session.defaultStore
    Debug.Print myDefaultStore
    
    ' This references a calendar on the same level as the default calendar
    Set nonDefaultCalendar = myOlApp.Session.Folders(myDefaultStore.DisplayName).Folders("Calendar Name")
    nonDefaultCalendar.Display
    
    ' Add to non-default folders (or create in the default then copy or move)
    Set myItem = nonDefaultCalendar.Items.Add
    With myItem
        .Subject = " Rangebank PS "
        .Display
    End With

Else
    MsgBox "Error creating Outlook object."
    
End If

End Sub