将Excel约会导入Outlook共享日历

Question

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

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

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

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

Answer 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

这是我的设置视图。