IT Knowledge Base

01. 同事問了一個Outlook問題，題及在搜尋中已找到了電郵，但究竟這個電郵收藏在那個Outlook資料夾內呢？

02. Outlook可以在顯示中加入『在資料夾』(In Folder)選項，那便可以看到電郵是在那裡。

03. 問題又來了，當用戶Outlook資料夾不只是一層，而是資料夾內再有資料夾的情況，要知道在『在資料夾』(In Folder)究竟出現在那裡，這就是今天的題目。

04. 考慮了三個情況，第一是用戶知道了資料夾的名稱，只需要尋找資料夾的位置。第二是用戶使用Outlook搜尋電郵功能，想知道被搜尋的電郵會在那個資料夾。第三就是因應Outlook『在資料夾』(In Folder)選項的限制，當資料夾名稱在Outlook中不只出現一次，便會出現找到相同的資料夾名稱，但電郵卻不是儲存在那裡的情況。

05. 第一二個情況最容易解決，只要輸入名稱，或在選取電郵中找到『在資料夾』(In Folder)名稱，便可以尋找Outlook相同資料夾名稱，之後再將結果顯示出來。但考慮到上面第三個情況，程式會再加一功能，詢問用戶是否再尋找，下一個相同名稱的資料夾名稱，直到所有資料夾也被尋找至少一次。

Sub FindFolderByName()
Dim Name As String
Dim FoundFolder As folder
Name = InputBox("Enter the folder name?")
If Len(Trim$(Name)) = 0 Then
MsgBox "Folder name is invalid", vbInformation
Exit Sub
End If
Set FoundFolder = FindInFoldersByName(Application.Session.Folders, Name)
MsgBox "Search complete", vbInformation
End Sub

Sub FindFolderByEmail()
Dim Name As String
Dim FoundFolder As folder
Dim currentExplorer As Explorer
Dim Selection As Selection
Set currentExplorer = Application.ActiveExplorer
Set Selection = currentExplorer.Selection
If Selection.count < 1 Then
MsgBox "No email selected", vbInformation
Exit Sub
Else
Name = Selection.Item(1).Parent.Name
End If
Set FoundFolder = FindInFoldersByName(Application.Session.Folders, Name)
End Sub

Function FindInFoldersByName(TheFolders As Outlook.Folders, Name As String)
Dim SubFolder As Outlook.MAPIFolder
Set FindInFoldersByName = Nothing
On Error Resume Next
For Each SubFolder In TheFolders
If LCase(SubFolder.Name) = LCase(Name) Then
If MsgBox("Folder name found in: " & vbCrLf & SubFolder.FolderPath & vbCrLf & "Choose Yes to search more folder with same name" & vbCrLf & "Choose No will go the folder location", vbQuestion Or vbYesNo) = vbYes Then
Set FindInFoldersByName = FindInFoldersByName(SubFolder.Folders, Name)
Else
Set Application.ActiveExplorer.CurrentFolder = SubFolder
MsgBox "Folder located", vbInformation
End
End If
Else
Set FindInFoldersByName = FindInFoldersByName(SubFolder.Folders, Name)
If Not FindInFoldersByName Is Nothing Then
Exit For
End If
End If
Next
End Function

06. 第三個情況，利用Outlook中每個電郵唯一的Entry ID，在Outlook資料夾中尋找相同的Entry ID。這是最理想的想法，但因為比對尋找的電郵可能會達幾千個，速度也是最慢一種方法。

Sub FindFolderByEntryID()
Dim Name As String
Dim EID As String
Dim FoundFolder As folder
Dim currentExplorer As Explorer
Dim Selection As Selection
Set currentExplorer = Application.ActiveExplorer
Set Selection = currentExplorer.Selection
If Selection.count < 1 Then
MsgBox "No email selected", vbInformation
Exit Sub
Else
Name = Selection.Item(1).Parent.Name
EID = Selection.Item(1).EntryID
End If
Set FoundFolder = FindInFolderByEntryID(Application.Session.Folders, Name, EID)
End Sub

Function FindInFolderByEntryID(TheFolders As Outlook.Folders, Name As String, EID As String)
Dim SubFolder As Outlook.MAPIFolder
Dim Item As Outlook.MailItem
Set FindInFolderByEntryID = Nothing
On Error Resume Next
For Each SubFolder In TheFolders
If LCase(SubFolder.Name) = LCase(Name) Then
MsgBox (Name)
For Each Item In SubFolder.Items
If EID = Item.EntryID Then
Set Application.ActiveExplorer.CurrentFolder = SubFolder
MsgBox ("Email found in this folder")
End
End If
Next
Set FindInFolderByEntryID = FindInFolderByEntryID(SubFolder.Folders, Name, EID)
Else
Set FindInFolderByEntryID = FindInFolderByEntryID(SubFolder.Folders, Name, EID)
If Not FindInFolderByEntryID Is Nothing Then
Exit For
End If
End If
Next
End Function