通过excel在非默认日历中添加约会的方法

我试图通过VBA将约会添加到Outlook中，并且当我将约会添加到默认日历时，所有正常但我不知道将此约会添加到另一个的方法Outlook中的日历。通过excel在非默认日历中添加约会的方法

下一个代码是用于默认日历：

子约会（）

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

结束子

林尝试使用“文件夹”对象来设置所述非默认日历但擅长总是检索到一个编译错误。

次约会（）

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和IM试图修改为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

末次

谁都可以帮助我呢？

来源

2013-11-01 Adrián Pulido del Castillo

线

集OLAppointment = miCalendario.Item.Add（olAppointmentItem）

必须是

Set OLAppointment = miCalendario.Items.Add(olAppointmentItem)

来源

2013-11-01 14:10:05

罗，出现同样的错误：\ –

什么是确切的错误？它提出了什么？ –

固定！非常感谢！ –

通过excel在非默认日历中添加约会的方法

回答

相关问题