1

Excel を使用して 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
4

1 に答える 1

4

この線

OLAppointment = miCalendario.Item.Add(olAppointmentItem) を設定します。

でなければなりません

 Set OLAppointment = miCalendario.Items.Add(olAppointmentItem)
于 2013-11-01T14:10:05.733 に答える