IT Knowledge Base

01. 公司秘書提到，每次在Outlook行事曆(calendar)尋找重覆會議邀請(meeting invitation)時，顯示出來記錄總是得一條記錄。如想知道重覆會議實際日期，每次也要打開此邀請，再自己計算實際日期。如果只是那些每兩星期開一次的會議是沒有問題的，但如果是那些每幾個月第幾個星期某一日的會議，想也頭痛了。

02. 正常在Outlook尋找會議邀請，如果是尋找重覆會議，只會顯示為一行。

03. 如果只想在Outlook中設定只尋找重覆會議，可在『Search』目錄、『Refine』下選『More』，再選『Recurring』。

04. 在『Recurring』欄位選擇『Yes』，再輸入要尋找的主旨。

05. 在『Microsoft網站』看到這樣的回覆『Outlook’s list view shows the appointments as 1 event because they are 1 event. The only way to get a list of individual events to is to export to a CSV file or use a macro to split it onto individual events.』。但每次想到要輸出一個檔案，先看到重覆會議內容，真的很麻煩。

06. 在網上世界『找一下』，找到可以將相關重覆會議內容，用VBA放到一個新電郵內，這個方法似乎方便得多。

07. 上面提到的VBA方法，就是選取一個重覆會議邀請，再執行程式，列出相同重覆會議邀請主題一樣的內容。

08. 但想到秘書不會那麼容易收貨。第一，如果同一重覆會議邀請主題有相同時，便會同時出現所有記錄。第二，如果根本只記不起會議主題部份文字呢？第三，秘書根本不肯定要尋找的記錄，一定是重覆會議。第四，找到記錄及要在特定日期更改某一天重覆會議又要如何做呢？

09. 所以，將以上VBA更改一下，分了3部份。

10. 第一部份，保留程式的大部份，只是將搜尋重覆會議邀請日期，設定為當天的前後1年。只要選取要尋找的重覆會議邀請，再執行程式，便會找到前後1年內，相同會議主題的所有記錄。

Sub WithSelectionRecurring()
Dim CalFolder As Outlook.MAPIFolder
Dim CalItems As Outlook.Items
Dim ResItems As Outlook.Items
Dim sFilter, strSubject, strOccur As String
Dim iNumRestricted As Integer
Dim itm, ListAppt As Object
Dim tStart, tEnd As Date
Set CalFolder = Application.ActiveExplorer.CurrentFolder
Set CalItems = CalFolder.Items
CalItems.Sort "[Start]"
CalItems.IncludeRecurrences = True
tStart = Format(Now - 365, "Short Date")
tEnd = Format(Now + 365, "Short Date")
strSubject = Application.ActiveExplorer.Selection.Item(1).Subject
sFilter = "[Start] >= '" & tStart & "' And [End] < '" & tEnd & "' And  [IsRecurring]  = True And [Subject] = " & "'" & strSubject & "'"
Set ResItems = CalItems.Restrict(sFilter)
iNumRestricted = 0
For Each itm In ResItems
iNumRestricted = iNumRestricted + 1
strOccur = strOccur & vbCrLf & itm.Subject & vbTab & " >> " & vbTab & Format(itm.Start, "mm/dd/yyyy hh:mm AM/PM (ddd)") & vbTab & " to: " & vbTab & Format(itm.End, "mm/dd/yyyy hh:mm AM/PM (ddd)")
Next
Set ListAppt = Application.CreateItem(olMailItem)
ListAppt.Body = strOccur & vbCrLf & iNumRestricted & " occurrences found."
ListAppt.Display
Set itm = Nothing
Set ListAppt = Nothing
Set ResItems = Nothing
Set CalItems = Nothing
Set CalFolder = Nothing
End Sub

08. 第二部份，將選取重覆會議邀請方式，更改為用戶自行輸入主題。只要輸入文字，有出現在前後1年內，只有部份文字出現在會議主題內，也會顯示出來。

Sub WithSubjectRecurring()
Dim CalFolder As Outlook.MAPIFolder
Dim CalItems As Outlook.Items
Dim ResItems As Outlook.Items
Dim sFilter, strSubject, strOccur As String
Dim iNumRestricted As Integer
Dim itm, ListAppt As Object
Dim tStart, tEnd As Date
Set CalFolder = Application.ActiveExplorer.CurrentFolder
Set CalItems = CalFolder.Items
CalItems.Sort "[Start]"
CalItems.IncludeRecurrences = True
tStart = Format(Now - 365, "Short Date")
tEnd = Format(Now + 365, "Short Date")
strSubject = InputBox("Enter meeting title")
If strSubject = "" Then
MsgBox ("No text input")
Exit Sub
End If
sFilter = "[Start] >= '" & tStart & "' And [End] < '" & tEnd & "' And  [IsRecurring]  = True"
Set ResItems = CalItems.Restrict(sFilter)
iNumRestricted = 0
For Each itm In ResItems
If (InStr(1, itm.Subject, strSubject, vbTextCompare) >= 1) Then
iNumRestricted = iNumRestricted + 1
strOccur = strOccur & vbCrLf & itm.Subject & vbTab & " >> " & vbTab & Format(itm.Start, "mm/dd/yyyy hh:mm AM/PM (ddd)") & vbTab & " to: " & vbTab & Format(itm.End, "mm/dd/yyyy hh:mm AM/PM (ddd)")
End If
Next
Set ListAppt = Application.CreateItem(olMailItem)
ListAppt.Body = strOccur & vbCrLf & iNumRestricted & " occurrences found."
ListAppt.Display
Set itm = Nothing
Set ListAppt = Nothing
Set ResItems = Nothing
Set CalItems = Nothing
Set CalFolder = Nothing
End Sub

09. 最後一部份，就是當用戶選取(highlight)電郵內日期，再執行程式，便會在Outlook中打開該日的行事曆。

Sub GoToDate()
Dim oCV As Outlook.CalendarView
Dim oExpl As Outlook.Explorer
Dim datGoTo As Date
Dim objDoc As Object
Dim objSel As Object
Set objDoc = ActiveInspector.WordEditor
Set objSel = objDoc.Windows(1).Selection
If (IsDate(objSel) = 0) Then
MsgBox ("Select date first")
Exit Sub
End If
datGoTo = objSel
Set oExpl = Application.Explorers.Add(Application.Session.GetDefaultFolder(olFolderCalendar), olFolderDisplayFolderOnly)
oExpl.Display
Set oCV = oExpl.CurrentView
oCV.CalendarViewMode = olCalendarViewWeek
oCV.GoToDate datGoTo
End Sub