# Outlook VSTO: Fastening email loop on a large pst file

In a Outlook VSTO Addin I needed to loop through a large pst file (e.g 30GB containing 50k+ mails). Following code block loop the pst file folder by folder recursively. It takes huge time (1hour+) to complete the loop especially when looping such large pst file for the first time.

The purpose of this code is to get the PR_SEARCH_KEY and the FolderPath of each email (folder wise) and store them in text file which will be used in future, such as in a periodic full loop we can compare the old and new PR_SEARCH_KEY to find out the new emails etc

How can I get a faster performance in this.

Const PropName As String = "http://schemas.microsoft.com/mapi/proptag/0x300B0102"
Dim SourceFolder = Outlook.NameSpace.Folders("Outlook_Backup")
Dim PstName = "Outlook"
Dim MailCount = FunctionToGetTotalMailCount(SourceFolder)
Dim PrSearchKeyDictionary As New List(Of String)

ScanPST(SourceFolder,PstName,MailCount)

Public Sub ScanPST(f As Outlook.Folder, PstName As String, MailCount As Long)
'-========================================================================
'- f = RootFolder/PST with Tag (e.g Outlook_Backup), PstName (e.g Outlook)
'-========================================================================
If f.Items.Count > 0 Then
For i = f.Items.Count To 1 Step -1
LoopCount += 1
Try
Dim Mail As Object = f.Items(i)
Dim PropertyAccessor As Outlook.PropertyAccessor = Mail.PropertyAccessor
Dim PrSearchKey As String = PropertyAccessor.BinaryToString(PropertyAccessor.GetProperty(PropName))

'/Full folder path splited into array and removed the rootfolder name with tag (e.g Outlook_Backup -> _Backup is the tag)
Dim FolderPath() As String = f.FolderPath.TrimStart("\"c).Split("\").Skip(1).ToArray

'/Array joined back to get MailFolderPath without tag
Dim MailFolderPath As String = String.Join("\", FolderPath)

PrSearchKeyDictionary.Add(PrSearchKey & "," & PstName & "\" & MailFolderPath)
Marshal.ReleaseComObject(PropertyAccessor)
Catch ex As Exception
LogInput("[Error: " & ex.ToString & "]"
Continue For
End Try
BGWorkerStatus = "[" & PstName & "] " & "Scanning... " & Math.Round((LoopCount / MailCount) * 100, 2, MidpointRounding.AwayFromZero) & "%"
BackGroundWorker.ReportProgress(0, BGWorkerStatus)
Next
End If
If f.Folders.Count > 0 Then
For c = 1 To f.Folders.Count
OL.Folder = f.Folders.Item(c)
ScanPST(OL.Folder, PstName, MailCount)
Next
End If
End Sub

• Please do not update the code in your question to incorporate feedback from answers, doing so goes against the Question + Answer style of Code Review. This is not a forum where you should keep the most updated version in your question. Please see what you may and may not do after receiving answers. Sep 20 '18 at 10:56

After looking at your code I see some stuff which could speed this up if coded different.

'/Full folder path splited into array and removed the rootfolder name with tag (e.g Outlook_Backup -> _Backup is the tag)
Dim FolderPath() As String = f.FolderPath.TrimStart("\"c).Split("\").Skip(1).ToArray

'/Array joined back to get MailFolderPath without tag
Dim MailFolderPath As String = String.Join("\", FolderPath)


For each Item in f.Items you are trimming the FolderPath and Split it by \ to Skip the first arrayitem before you call ToArray(). The ToArray() isn't needed because this overload of String.Join would take an IEnumerable(Of String).

But the main point here is that f.FolderPath won't change for each Item. It would be much faster to pull this outside of the For loop.

Removing the BackGroundWorker.ReportProgress() for each and every Item would speed this up as well. How about reporting progress only for each folder?

Although VB.NET isn't case sensitive it would be good to follow the .Net Naming Guidelines for naming things.

• Thank You. Im going to apply your suggestion and will get back to you soon. Sep 20 '18 at 8:08
• I've applied the modified version (included in main post) according to your suggestion. But its still taking more than an hour. Sep 20 '18 at 10:26
• Did you compile it using release mode ? Sep 20 '18 at 10:57
• How often did the code throw an exception? Sep 20 '18 at 10:58
• Yes, It was in release mode and this code block doesn't usually through exceptions. Sep 20 '18 at 11:43

I don't see the need for recursion, you could store the folders in a stack instead.

    Dim foldersToProcess As New Stack(Of Outlook.Folder)

' Add root folder

While foldersToProcess.Count > 0
Dim curfolder = foldersToProcess.Pop()

' Process folder

' Add child folders
For Each childFilter In f.Folders
foldersToProcess.Push(childFilter)
Next
End While


You might not need OL here since you put it right back

OL.Folder = f.Folders.Item(c)
ScanPST(OL.Folder, PstName, MailCount)


Your split and join could be reduce to an indexOf with a substring

    Dim folder = "\aaa\bbb\ccc"
Dim newFolder = folder.Substring(folder.IndexOf("\", 2)) ' Will equal" \bbb\ccc"


Like Heslacher said, you don't need to ReportProgress every changes. Especially with all the math and string concatenation done for BGWorkerStatus (maybe look at string builder).

If things are the same (like PrSearchKey or MailFolderPath) for the same folder, it shouldn't be calculated multiple time.

If exceptions happen often, try to do a check that would prevent it from happening. Exceptions are slow.