通过Excel在非默认日历中添加约会的方法 [英] method to add appointment in non default calendar through excel

问题描述

当我将约会添加到默认日历中，但是我不知道将约会添加到Outlook中另一个日历的方法时，我试图通过带有VBA的Excel将约会添加到Outlook中.

Im trying to add appointments to Outlook through Excel with VBA and all its ok when i add the appointment to the default calendar but i dont know the method to add this appointment to an another calendar in Outlook.

下一个代码用于默认日历:

The next code is for default calendar:

Sub Appointments()

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    

结束子

我正在尝试使用文件夹"对象设置非默认日历，但是excel始终会检索到我的编译错误.

Im trying to use the "Folders" object to set the non default calendar but excel retrieves me a compile error always.

Sub Appointments()

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

结束子

任何人都可以帮助我吗?

Anyone can help me please?

谢谢.

我已经为Outlook制作了此脚本，并尝试为Excel进行修改...

I have made this script for Outlook and im trying to modify for Excel...

Sub AddContactsFolder()

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.Item.Add(olAppointmentItem)

必须

 Set OLAppointment = miCalendario.Items.Add(olAppointmentItem)

这篇关于通过Excel在非默认日历中添加约会的方法的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！