方法通过excel在非默认日历中添加约会
我试图添加约会到Outlook通过与VBA的Excel和所有好的时候，我将约会添加到默认日历，但我不知道方法将此约会添加到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 …
Sub 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
结束小组
任何人都可以帮助我呢？
该线
设置OLAppointment = miCalendario.Item.Add（olAppointmentItem）
一定是
Set OLAppointment = miCalendario.Items.Add(olAppointmentItem)