通過Excel在非默認日歷中添加約會的方法

Question

我試圖通過帶有VBA的Excel通過Excel將約會添加到Outlook中，並且在將約會添加到默認日歷中時一切正常，但是我不知道將約會添加到Outlook中另一個日歷的方法。

下一個代碼用於默認日歷：

子約會（）

Const olAppointmentItem As Long = 1

Dim OLApp As Object

Dim OLNS As Object

Dim OLAppointment As Object

On Error Resume Next

Set OLApp = GetObject(, "Outlook.Application")

If OLApp Is Nothing Then Set OLApp = CreateObject("Outlook.Application")
On Error GoTo 0

If Not OLApp Is Nothing Then

    Set OLNS = OLApp.GetNamespace("MAPI")
    OLNS.Logon
    Set OLAppointment = OLApp.Item.Add(olAppointmentItem)
    OLAppointment.Subject = Range("A1").Value
    OLAppointment.Start = Range("C3").Value
    OLAppointment.Duration = Range("C1").Value
    OLAppointment.ReminderMinutesBeforeStart = Range("D1").Value
    OLAppointment.Save

    Set OLAppointment = Nothing
    Set OLNS = Nothing
    Set OLApp = Nothing
End If    

結束子

我試圖使用“文件夾”對象來設置非默認日歷，但excel總是檢索到我一個編譯錯誤。

子約會（）

Const olAppointmentItem As Long = 1

Dim OLApp As Object
Dim OLNS As Object
Dim OLAppointment As Object
Dim miCalendario As Object
On Error Resume Next
Set OLApp = GetObject(, "Outlook.Application")
If OLApp Is Nothing Then Set OLApp = CreateObject("Outlook.Application")
On Error GoTo 0

If Not OLApp Is Nothing Then

    Set OLNS = OLApp.GetNamespace("MAPI")
    OLNS.Logon
    Set miCalendario = OLApp.Session.GetDefaultFolder(9).Folders("a")
    Set OLAppointment = miCalendario.Item.Add(olAppointmentItem)
    OLAppointment.Subject = Range("A1").Value
    OLAppointment.Start = Range("C3").Value
    OLAppointment.Duration = Range("C1").Value
    OLAppointment.ReminderMinutesBeforeStart = Range("D1").Value
    OLAppointment.Save

    Set OLAppointment = Nothing
    Set OLNS = Nothing
    Set OLApp = Nothing
End If

結束子

有人可以幫我嗎？

提前致謝。

編輯：

我已經為Outlook創建了此腳本，並嘗試為Excel進行修改...

子AddContactsFolder（）

Dim myNameSpace As Outlook.NameSpace
Dim myFolder As Outlook.Folder
Dim myNewFolder As Outlook.AppointmentItem
Set myNameSpace = Application.GetNamespace("MAPI")
Set myFolder = myNameSpace.GetDefaultFolder(olFolderCalendar).Folders("aa")
MsgBox myFolder
Set myNewFolder = myFolder.Items.Add(olAppointmentItem)
With myNewFolder
    .Subject = "aaaaa"
    .Start = "10/11/2013"
    .ReminderMinutesBeforeStart = "20"
    .Save
End With

結束子

有人可以幫我嗎？

Answer 1

線

設置OLAppointment = miCalendario.Item.Add（olAppointmentItem）

一定是

 Set OLAppointment = miCalendario.Items.Add(olAppointmentItem)