将 Excel 约会导入 Outlook 共享日历答案

【问题标题】：Import Excel Appointments to Outlook Shared Calendar将 Excel 约会导入 Outlook 共享日历
【发布时间】：2018-01-12 16:04:08
【问题描述】：

我正在尝试使用以下格式的 Excel VBA 在 Excel 中导入约会日历：

Subject        Start            End             Location
Breakfast      8/7/17 9:00 AM   8/7/17 9:30 AM  Cafe

我在运行此宏时在.Start = ThisWorkbook.Sheets(1).Cells(NextRow, 2) 遇到“运行时错误 438：对象不支持此属性或方法”：

Sub TestCalendar()

Dim OLApp As Object
Dim OLName As Object
Dim OLFolder As Object
Dim OLAppt As Object
Dim NextRow As Long

Set OLApp = CreateObject("Outlook.Application")

Set OLName = OLApp.GetNamespace("MAPI")

Set OLFolder = OLName.GetDefaultFolder(9).Folders("Test")

NextRow = 2

Do Until Trim(ThisWorkbook.Sheets(1).Cells(NextRow, 1)) = ""

Set OLAppt = OLApp.CreateItem(olAppointmentItem)

With OLAppt

.Subject = ThisWorkbook.Sheets(1).Cells(NextRow, 1)
.Start = ThisWorkbook.Sheets(1).Cells(NextRow, 2)
.End = ThisWorkbook.Sheets(1).Cells(NextRow, 3)
.Location = ThisWorkbook.Sheets(1).Cells(NextRow, 4)
.Save
End With

NextRow = NextRow + 1
Loop

Set OLAppt = Nothing
Set OLFolder = Nothing
Set OLName = Nothing
Set OLApp = Nothing

End Sub

【问题讨论】：

您确定日期是真实日期而不是看起来像日期的文本吗？
感谢您的检查。我查看了 Excel 中的格式，它的格式是日期而不是文本。
如果单元格中的文本或日期是单元格中的文本或日期，则不会因为单元格以一种方式格式化。您可以将单元格格式化为“短日期”并输入AAAAAA，它将保持格式为“短日期”但显示AAAAAA。如果将格式更改为“数字”，值会改变吗？如果不是，它是文本而不是日期。同样，这只是一个猜测。
@ScottCraner - 我是说，你不知道这里的问题是什么并不意味着你比其他人更聪明。
@Chris - 试试ThisWorkbook.Sheets(1).Cells(NextRow, 2).Value2。或尝试Format(ThisWorkbook.Sheets(1).Cells(NextRow, 2).Value2,"mm/dd/yyyy hh:mm AM/PM") 或任何需要的格式。如果失败，请尝试在线调查该字段所需的格式，或对该字段的现有出现执行 debug.print，然后匹配。底线是格式需要以某种方式，你只需要找到确切的语法:)

标签： excel vba outlook calendar

【解决方案1】：

以下脚本对我有用。

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

    ' Start at row 2
    r = 2

    Do Until Trim(Cells(r, 1).Value) = ""
        ' 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, 3).Value
        myApt.Duration = Cells(r, 4).Value
        ' If Busy Status is not specified, default to 2 (Busy)
        If Trim(Cells(r, 5).Value) = "" Then
            myApt.BusyStatus = 2
        Else
            myApt.BusyStatus = Cells(r, 5).Value
        End If
        If Cells(r, 6).Value > 0 Then
            myApt.ReminderSet = True
            myApt.ReminderMinutesBeforeStart = Cells(r, 6).Value
        Else
            myApt.ReminderSet = True
        End If
        myApt.Body = Cells(r, 7).Value
        myApt.Save
        r = r + 1
    Loop
End Sub

这是我的设置视图。

【讨论】：

谢谢@ryguy72！您的回答有效，但是，如果我想在我创建的 Outlook 共享日历上执行此操作（例如名称为“Test”）怎么办？
@chris 使用 .Add 而不是为非默认文件夹创建