[펌] 아웃룩 중복 일정 제거 VBS
digital & analog
2008. 4. 8. 13:45
PDA 와 아웃룩 일정을 싱크하면 중복 일정이 생기는 버그가 있을 수 있다.
아웃룩에서 ALT+F11 을 눌러서 모듈을 VBS 를 추가해서 실행하여 해결 할 수 있다.
어떤 분이 작성한 코드에다가 하루 종일 일정이 삭제 되지 않는 문제가 있어서,
강제로 시간을 붙여서 처리해 주는 부분을 추가하였다.
[Duplicate Appointment Delete VBS]
아웃룩에서 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
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
'digital & analog' 카테고리의 다른 글
2008 베이징 올림픽 성화 봉송 (0) | 2008.04.28 |
---|---|
wide 모니터를 효과적으로 분할하는 WinSpit.. (0) | 2008.02.25 |
PDF문서를 책보듯 펼쳐 보는 ezPDF Reader (0) | 2008.02.23 |