有没有一种方法可以避免VBA上重复的Outlook约会?

时间:2020-03-09 13:43:42

标签: excel vba outlook calendar appointment

我试图写出一个vba脚本,其中每次我在Excel上添加新条目时,它仅添加新约会。每当我第二次使用新条目运行代码时,它都会向日历添加重复的约会。有没有一种方法可以只添加新条目而不重复以前的约会?

Sub AddAppointments()
    ' Columns Start date(7), Columns start time(8), End time (9), reminder (10), status(11) is mostly busy(value is 2)

    ' 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 = "Remove " + Cells(r, 1).Value
        myApt.Location = "Work drive"
        'Start time
        myApt.Start = Cells(r, 7).Value + Cells(r, 8).Value
        'Duration column
        myApt.Duration = Cells(r, 9).Value
        ' If Busy Status is not specified, default to 2 (Busy)
        If Trim(Cells(r, 11).Value) = "" Then  'Column 11 is represented the busy status(2)
            myApt.BusyStatus = 2
        Else
            myApt.BusyStatus = Cells(r, 11).Value
        End If
        If Cells(r, 10).Value > 0 Then
            myApt.ReminderSet = True
            myApt.ReminderMinutesBeforeStart = Cells(r, 10).Value 'reminder status within 30mins as noted under column 10
        Else
            myApt.ReminderSet = False
        End If
        myApt.Body = "Remove " + Cells(r, 1).Value  'pulls name from column 1
        myApt.Save
        r = r + 1
    Loop
End Sub

0 个答案:

没有答案