在非默认日历的命名日历中从 Excel 创建 Outlook 日历事件

Question

我创建了以下代码来创建一个包含来自单元格的特定信息的 Outlook 日历事件。

我需要将其从默认日历更改为不同的命名日历“测试”。

其中有很多编辑，所以有些代码可能无法使用，但如果它没有破坏它，我就没有删除它。例如这用于向收件人发送电子邮件。

Sub CreateAppointmentBuildVhub()
    ' Outlook application object.
    
    'FOR CALENDAR ONLY
    Dim objOL       As Object
    ' Appointment item object.
    Dim objItem     As Object
    ' TimeZone object that represents "Eastern Standard Time" in Outlook.
    Dim tzEastern   As Object
    'FOR CALENDAR AND EMAIL
    Dim AWorksheet As Worksheet
    'FOR EMAIL ONLY
    Dim Sendrng As Range
    Dim Rng As Range
    
       
    'FOR CALENDAR ENTRY
    Set objOL = GetObject(, "Outlook.Application")
    Set tzEastern = objOL.TimeZones.Item("Eastern Standard Time")
    Set objItem = objOL.CreateItem(1)
    Set AWorksheet = ActiveSheet
    'FOR EMAIL SEND
       
    
    With objItem
        .Start = Worksheets("Info").Range("C14").Text
        .StartTimeZone = tzEastern
        
        .Body = Worksheets("Info").Range("C2") & Chr(10) & Worksheets("Info").Range("C3") & Chr(10) & Worksheets("Info").Range("C4") & Chr(10) & Chr(10) & Worksheets("Info").Range("E2") & Chr(10) & Worksheets("Info").Range("E3")
        .Location = Worksheets("Info").Range("C3")
        .AllDayEvent = True
        .Subject = Worksheets("Info").Range("B14")
        .ReminderMinutesBeforeStart = 15
        .ReminderSet = False
        .Display
    End With
    Set objItem = Nothing
    Set objOL = Nothing
    Set tzEastern = Nothing
    

   'Activate the sheet that was active before you run the macro
    AWorksheet.Select
    
    'STOPS SCRIPT IF ERRORS
   

End Sub

Answer 1

您需要在需要创建约会的文件夹上调用 MAPIFolder.Items.Add，而不是调用 Application.CreateItem(olAppontment)。

假设“Test”是默认日历文件夹的子文件夹：

set folder = objOL.Session.GetDefaultFolder(olFolderCalendar).Folders("Test")
Set objItem = folder.Items.Add

Answer 2

这正是我所需要的。

Sub CreateAppointmentBuildVhub()
    ' Outlook application object.
    
    'FOR CALENDAR ONLY
    Dim objOL       As Object
    ' Appointment item object.
    Dim objItem     As Object
    ' TimeZone object that represents "Eastern Standard Time" in Outlook.
    Dim tzEastern   As Object
    'FOR CALENDAR AND EMAIL
    Dim AWorksheet As Worksheet
    'FOR EMAIL ONLY
    Dim Sendrng As Range
    Dim Rng As Range
    
       
    'FOR CALENDAR ENTRY
    Set objOL = GetObject(, "Outlook.Application")
    Set tzEastern = objOL.TimeZones.Item("Eastern Standard Time")
    
    Set AWorksheet = ActiveSheet
    'FOR EMAIL SEND
    Set Folder = objOL.Session.GetDefaultFolder(olFolderCalendar).Folders("Test")
    Set objItem = Folder.Items.Add
    
    With objItem
        .Start = Worksheets("Info").Range("C14").Text
        .StartTimeZone = tzEastern
        
        .Body = Worksheets("Info").Range("C2") & Chr(10) & Worksheets("Info").Range("C3") & Chr(10) & Worksheets("Info").Range("C4") & Chr(10) & Chr(10) & Worksheets("Info").Range("E2") & Chr(10) & Worksheets("Info").Range("E3")
        .Location = Worksheets("Info").Range("C3")
        .AllDayEvent = True
        .Subject = Worksheets("Info").Range("B14")
        .ReminderMinutesBeforeStart = 15
        .ReminderSet = False
        .Display
    End With
    Set objItem = Nothing
    Set objOL = Nothing
    Set tzEastern = Nothing
    

   'Activate the sheet that was active before you run the macro
    AWorksheet.Select
    
    'STOPS SCRIPT IF ERRORS
   

End Sub

在非默认日历的命名日历中从 Excel 创建 Outlook 日历事件

Create a Outlook Calendar event from Excel in a named calendar that is not the default one

excel

outlook

vba

calendar