Question

我试图通过Excel使用VBA向Outlook添加约会，当我将约会添加到默认日历但我不知道将此约会添加到Outlook中的另一个日历时的所有方法。

下一个代码是默认日历：

Sub Appointments（）

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

End Sub

我试图使用“文件夹”对象设置非默认日历，但excel总是检索到编译错误。

Sub Appointments（）

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

End Sub

任何人都可以帮助我吗？

提前致谢。

编辑：

我为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

End Sub

任何人都可以帮我这个吗？

Answer 1

该行

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

必须是

 Set OLAppointment = miCalendario.Items.Add(olAppointmentItem)

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

1 个答案: