我试图写出一个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