vba Excel 创建 Outlook 日历事件

Excel Create an Outlook calendar event

提问by orangehairbandit

Can you run a macro from Excel that can interact with Outlook and create and event on the calendar?

您可以从 Excel 运行一个宏，该宏可以与 Outlook 交互并在日历上创建和事件吗？

回答by ozmike

Slight improvement on other answer

其他答案略有改进

Sub createappt()

Const olFolderCalendar = 9
Const olAppointmentItem = 1 '1 = Appointment

Set objOutlook = CreateObject("Outlook.Application")

'Set objOutlook = GetObject(, "Outlook.Application")  ' outlook already open
Set objNamespace = objOutlook.GetNamespace("MAPI")
Set Items = objNamespace.GetDefaultFolder(olFolderCalendar).Items

Set objCalendar = objNamespace.GetDefaultFolder(olFolderCalendar).Folders("subfolder")
Set objCalendar = objNamespace.GetDefaultFolder(olFolderCalendar) ' main calender
Set objapt = objCalendar.Items.Add(olAppointmentItem)
objapt.Subject = "Test" 'Owner
objapt.Start = Date + TimeValue("08:00:00")
objapt.Duration = 60 * 8 'Duration(in minutes) OR End(I'm not sure so try both)
objapt.End = Date + TimeValue("16:00:00")
objapt.Save
End Sub

回答by Mark

This will allow you to add an appointment to a shared Calendar in any folder as long as you have the rights to write in it.

这将允许您将约会添加到任何文件夹中的共享日历，只要您有权在其中写入。

Treat Calendar as a Folder

将日历视为文件夹

Const olFolderInbox = 6
Const olAppointmentItem = 1 '1 = Appointment

Set objOutlook = CreateObject("Outlook.Application")
Set objNamespace = objOutlook.GetNamespace("MAPI")
'Finds your Inbox
Set objInbox = objNamespace.GetDefaultFolder(olFolderInbox)

'Gets the parent of your Inbox which gives the Users email
strFolderName = objInbox.Parent
Set objCalendar = objNamespace.Folders("Public folders - " & strFolderName).Folders("SubFolder1").Folders("subfolder of subfolder 1").Folders("Your Calendar")

Set objapt = objCalendar.Items.Add(olAppointmentItem)
objapt.Subject = "Test" 'Owner
objapt.Start = Date + TimeValue("08:00:00")
objapt.Duration = 60 * 8 'Duration(in minutes) OR End(I'm not sure so try both)
objapt.End= Date + TimeValue("16:00:00")
objapt.Save

回答by 0m3r

Link from Tim's commment - http://excelexperts.com/Creating-appointments-for-outlook-in-VBA

来自 Tim 评论的链接 - http://excelexperts.com/Creating-appointments-for-outlook-in-VBA

Sub AddAppointments2()
    ' Create the Outlook session
    Set myOutlook = CreateObject("Outlook.Application")

    ' Start at row 2
    r = 2

    Do Until Trim(Cells(r, 1).Value) = ""
        For Each olapt In olFldr.Items
            If TypeName(myApt) = "AppointmentItem" Then
                If InStr(1, myApt.Subject, "Test and Tag", vbTextCompare) Then
                    myApt.Body = appt.Body & Cells(r, 2)
                    myApt.Save
                Else
                    ' Create the AppointmentItem
                    Set myApt = myOutlook.createitem(1)
                    ' Set the appointment properties
                    myApt.Subject = Cells(r, 1).Value
                    myApt.Location = Cells(r, 2).Value
                    myApt.Start = Cells(r, 4).Value + TimeValue("08:00:00")
                    myApt.Duration = Cells(r, 5).Value
                    ' If Busy Status is not specified, default to 2 (Busy)
                    If Trim(Cells(r, 6).Value) = "" Then
                        myApt.BusyStatus = 2
                    Else
                        myApt.BusyStatus = Cells(r, 6).Value
                    End If
                    If Cells(r, 7).Value > 0 Then
                        myApt.ReminderSet = True
                        myApt.ReminderMinutesBeforeStart = Cells(r, 7).Value
                    Else
                        myApt.ReminderSet = False
                    End If
                    myApt.Body = Cells(r, 12).Value
                    myApt.Save
                    r = r + 1
                End If
            End If
        Next olapt
    Loop
End Sub

Here is other link https://stackoverflow.com/a/49121400/4539709

这是其他链接https://stackoverflow.com/a/49121400/4539709