PDA 와 아웃룩 일정을 싱크하면 중복 일정이 생기는 버그가 있을 수 있다.

아웃룩에서 ALT+F11 을 눌러서 모듈을 VBS 를 추가해서 실행하여 해결 할 수 있다.

어떤 분이 작성한 코드에다가 하루 종일 일정이 삭제 되지 않는 문제가 있어서,

강제로 시간을 붙여서 처리해 주는 부분을 추가하였다.

[Duplicate Appointment Delete VBS]

Sub DelDuplicateAppointment()
Dim oApItem As AppointmentItem
Dim iDelItem As Integer

For Each oApItem In GetNamespace("MAPI").GetDefaultFolder(olFolderCalendar).Items
' 아웃룩의 기본 일정 폴더의 모든 아이템을 검사합니다.

If DuplicateAppointment(oApItem.Start, oApItem.Subject) = True Then
' 제목과 시간으로 같은 항목이 존재하면 해당 항목을 삭제하고, 개수를 기록합니다.

oApItem.Delete
iDelItem = iDelItem + 1
End If
Next

' 처리 결과를 표시합니다.
If iDelItem > 0 Then
MsgBox "모두 " & iDelItem & "개의 중복 일정을 삭제했습니다.", vbInformation + vbOKOnly, "중복 일정 삭제"
Else
MsgBox "중복 일정이 존재하지 않습니다.", vbInformation + vbOKOnly, "중복 일정 삭제"
End If

Set oApItem = Nothing
End Sub

Function DuplicateAppointment(dRegDate As Date, sSubject As String) As Boolean
Dim oRegAppointmentItems As Items
Dim oFindAppointment As AppointmentItem
Dim sFilter As String
Dim str As String

DuplicateAppointment = False

str = dRegDate

If Len(str) > 10 Then
sFilter = "[start]=""" & dRegDate & """ and [subject]=""" & sSubject & """"
' 검색 조건을 지정합니다.
Else
str = dRegDate & " 오전 0:00:00"
sFilter = "[start]=""" & str & """ and [subject]=""" & sSubject & """"
' 종일 일정일 경우 시간 정보를 강제로 붙여줍니다.
' 검색 조건을 지정합니다.
End If

Set oRegAppointmentItems = GetNamespace("MAPI").GetDefaultFolder(olFolderCalendar).Items
' 아웃룩의 기본 일정 폴더내 모든 아이템을 변수에 할당합니다.

Set oFindAppointment = oRegAppointmentItems.Find(sFilter)
' 검색조건과 일치하는 일정을 변수에 할당합니다.

Set oFindAppointment = oRegAppointmentItems.FindNext
' 똑같은 검색조건으로 찾아지는 일정을 변수에 할당합니다.

If Not oFindAppointment Is Nothing Then
' 두 번째 일치하는 일정이 존재하면 중복임을 표시합니다.
DuplicateAppointment = True
End If

Set oFindAppointment = Nothing
Set oRegAppointmentItems = Nothing
End Function
Posted by logbook