Excel VBA在非默认日历中创建会议

Question

如何使用VBA代码在Outlook中非默认电子邮件地址的非默认日历上创建会议？

我拥有的代码在默认电子邮件地址的默认日历中创建邀请：

Sub CreateAppointmentOutlook()
Dim oApp As Outlook.Application
Dim oApt As Outlook.AppointmentItem
Dim oRecip As Outlook.Recipient
Dim i As Long
Dim lastRow As Long
Dim ws As Worksheet
Dim wb As ThisWorkbook
Set oApp = New Outlook.Application
Set ws = ActiveWorkbook.Worksheets("Sheet1")
lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
For i = 1 To lastRow
    Set oApt = oApp.CreateItem(olAppointmentItem)
    oApt.MeetingStatus = olMeeting
    Debug.Print (ws.Cells(i, 1).Value)
    With oApt
        .Subject = "Test"
        ' do some other stuff
    End With
Next i
End Sub

我甚至尝试更改日历的最接近的是这个参考。为了开始尝试在我的示例中实现此代码，我做了以下测试。

Sub Whatever()
Dim olApp As Object
Set olApp = GetObject(, "Outlook.Application")
Dim ns As Outlook.Namespace
Set ns = olApp.GetNamespace("MAPI")
Dim Items As Object
Set Items = GetFolderPath("[e-mail]").Items
Debug.Print (Items.Parent.FolderPath)
Debug.Print ("End")
End Sub

但是我收到运行时错误"91"：对象变量或未在行上设置块变量 设置项目 = GetFolderPath("[e-mail]\日历"(。项目

更新

此代码运行：

Sub Whatever()
Dim olApp As Object
Set olApp = GetObject(, "Outlook.Application") 
Dim oApt As Outlook.AppointmentItem
Dim ns As Outlook.Namespace
Dim oFolder As Outlook.Folder
Set ns = olApp.GetNamespace("MAPI")
Set oFolder = ns.Folders("[e-mail]")
Dim CalItems As Outlook.Items
Set CalItems = oFolder.Items
End Sub

但是，如何在其他CalItems文件夹集合上创建日历条目呢？

Answer 1

此代码将在Outlook中的非默认帐户中的非默认日历上创建约会。希望这将对其他人有所帮助：

Sub Whatever()
Dim olApp As Object
Set olApp = GetObject(, "Outlook.Application")
Dim oApt As Outlook.AppointmentItem
Dim ns As Outlook.Namespace
Dim recip As Outlook.Recipient
Dim oFolder As Outlook.Folder
Set ns = olApp.GetNamespace("MAPI")
Set recip = ns.CreateRecipient("[e-mail]")
If recip.Resolve Then
    Set otherFolder = ns.GetSharedDefaultFolder(recip, olFolderCalendar)
End If
Set oApt = otherFolder.Items.Add(olAppointmentItem)
oApt.MeetingStatus = olMeeting
    With oApt
        .Subject = "Test"
        .Start = "15/04/2019 09:00"
        .End = "15/04/2019 09:10"
        .Location = "The Business Meeting Room"
        .Recipients.Add ("[e-mail]")
        .Send
    End With
End Sub