How can I make my VBA Outlook script more efficient - vba

This is my first question on StackExchange ever :-)
I am Running the following script in MS Outlook VBA
Sub export()
On Error resume Next
Dim Ns As Outlook.NameSpace
Dim eitem
Dim oFile As Object
Dim fso As Object
Set Ns = Application.GetNamespace("MAPI")
Set fso = CreateObject("Scripting.FileSystemObject")
Set oFile = fso.CreateTextFile("C:\Users\chakkalakka\Desktop\mails.txt")
'Code
For Each eitem In Ns.Session.Folders.Item(12).Items
oFile.WriteLine eitem.SenderName & "§" & eitem.SentOnBehalfOfName & "§" & eitem.ReceivedTime
Next
oFile.Close
Set Ns = Nothing
Set fso = Nothing
Set oFile = Nothing
Debug.Print "Completed!"
End Sub
The script in general is working fine and the output is correct. My Problem is: I need to run this inside a folder with > 95000 items and it takes ages.
So my question is: What can I do to improve performance?
Thanks in advance for your help

The most inefficient line of code is the following one:
For Each eitem In Ns.Session.Folders.Item(12).Items
You need to break the chain of property and method calls and declare them on separate lines. So each property or method will be declared on a separate line of code. Thus, you will be able to release underlying COM objects instantly. Set a variable to Nothing in Visual Basic to release the reference to the object.
Iterating through all items in the folder is a time-consuming task. Instead, I'd suggest using the Find/FindNext or Restrict methods of the Items class to deal with items that correspond to your conditions. Read more about these methods in the following articles:
How To: Use Restrict method to retrieve Outlook mail items from a folder
How To: Use Find and FindNext methods to retrieve Outlook mail items from a folder (C#, VB.NET)
Also you may consider using the GetTable method of the Folder class which allows to obtain a Table object that contains items filtered by Filter. If Filter is a blank string or the Filter parameter is omitted, GetTable returns a Table with rows representing all the items in the Folder.

Related

Outlook VBA - MoveTo method does not accept my Folder variable as an object

All,
I wrote some VBA code to move the currently selected email folder in an Outlook session to a folder called "archive 2023". It did not work; I spent ages working out why but could not fix the code. Eventually, I settled it by researching and then coming at the problem from a different angle. Although happy, and learning a lot, I still don't know why my original code did not work. And that bugs me (if you excuse the pun).
I'll start with my original code that did not work - I've gone heavy on the comments.
Sub archive_a_folder()
'firsty create the variable I'll store the current folder in as an object
Dim current_folder As Outlook.Folder
'then put the folder, selected in the active instance of Outlook, into the variable
Set current_folder = Application.ActiveExplorer.CurrentFolder
Debug.Print current_folder.Name 'I put this in to check the above worked - and it did!
'I wrote a little code to find out the EntryID property of the folder called "archive 2023"
'I then put the EntryID (which is a string) into a variable
Dim archiveID As String
archiveID = "xxxx" 'instead of xxxx this is a really long string
'I then create a MAPI namespace so I can use the GetFolderFromID method
Dim ns As Outlook.NameSpace
Set ns = Application.GetNamespace("MAPI")
'I then create an Outlook.Folder variable and put the "archive 2023" folder in there by ...
'... using the GetFolderFromID method using the EntryID
Dim archive_folder As Outlook.Folder
Set archive_folder = ns.GetFolderFromID(archiveID)
Debug.Print archive_folder.Name 'Did this to check the above works and it does!
'So at this point I thought I had two correctly assigned Outlook.Folder object variables ...
'... One assigned with the folder that needs moving and one being the destination folder
'The documentation states the MoveTo method should be used like this...
'... Folder.MoveTo(Folder) with the first Folder (an object) being moved to the second.
current_folder.MoveTo(archive_folder)
'I get an object expected error.
End Sub
Running the code line by line proved everything was working right up to current_folder.MoveTo(archive_folder).
The debugging print outs show that the variables current_folder and archive_folder are correctly assigned. I even printed out the variables' types to ensure they were both of the Folder type and they were (they were actually type FolderMAPI but I think thats OK).
I tried creating a new Folder.Outlook variable and having the below statement:
set new_folder = current_folder.MoveTo(archive_folder)
or
new_folder = current_folder.MoveTo(archive_folder)
but niether worked. (I saw that the MoveTo method returned a Folder so that's why I tried that.
Eventually, after research, I re-wrote is like this and it worked.
Sub archive_folder()
'get the current folder and put it in a Folder variable
Dim current_folder As Outlook.Folder
Set current_folder = Application.ActiveExplorer.CurrentFolder
'get a namespace variable so I can use some of its methods later
Dim ns As Outlook.NameSpace
Set ns = Application.GetNamespace("MAPI")
'create inbox as a Folder variable
Dim inbox As Outlook.Folder
'using a namespace method assign the actual in-box to the inbox variable
'olFolderInbox is an inbuilt referene to the default in box folder
Set inbox = ns.GetDefaultFolder(olFolderInbox)
'create a Foler variable that will be assigned the destination folder
Dim archive_folder As Outlook.Folder
'this seems oddly cumbersome but works!
'take parent of the inbox Folder and look for "archive 2003" beneath it
'assign this to the archive folder variable.
Set archive_folder = inbox.Parent.Folders("archive 2023")
'The using the MoveTo method move the current_folder to the
'archive folder
current_folder.MoveTo archive_folder
'when I check in my Outlook window, its moved!
Exit Sub
End Sub
If I had to guess at what the problem is, its something to do with GetFolderFromID not returning a Folder object with all the properties needed for the MoveTo method to work.
I'm probably thinking too 'real world' mistakenly imagining folders actually being stored in other folders. The system probably just looks as the Parent and Folders properties of all the folders and builds a tree for the GUI. Mayube GetFolderFromID does not return these property values correctly so MoveTo does not think its an object at all this the error. This would seem likely if MoveTo just messed about with some of the parent / folders properties.
If this is the case though, what would be the point of the GetFolderFromID function?
Or maybe I'm being punished for trying to skip learning the basics of a language.
Any help?
Aldus
Edit:
I can't believe I did not clock that I should not have used parentheses for the MoveTo method. ##DmitryStreblechenko saw me right in the comments.
To make me feel better I massively reduced the size of the code...
Sub archive_a_folder()
archiveID = "xxx" `xxx is the EntrhyID of the destination folder
Application.ActiveExplorer.CurrentFolder.MoveTo Application.GetNamespace("MAPI").GetFolderFromID(archiveID)
End Sub
:-)
I want to show this question as answered but want to make clear it was answered in the comments and not by me. In essence, and I can't believe I made this mistake, I used parenthesis when I should not have.
Where I used current_folder.MoveTo(archive_folder) I should have used current_folder.MoveTo archive_folder
I fell for the old trick of assuming my syntax was correct but there was some deeper problem. But no, I just used a couple of brackets!
I used to code many years ago so have enough of an understanding to risk skipping some of the basics when learning a new language but the danger of that is what led to this question.
Oh well, you live and learn.

Is it possible to find related emails and loop the results in the background?

I'd like to find related emails to the email I have currently selected. Then I want to loop the results.
Using the ActiveExplorer.Search takes a moment, and at the same time the code keeps running. So it doesn't return any results, because of loading still happening in the background, I guess.
So my questions are:
How do I find related emails?
How do I loop the search results (in the background)?
To find related emails, maybe something like this:
Sub FindRelatedEmails()
Dim ns As Outlook.NameSpace
Set ns = myOlApp.GetNamespace("MAPI")
Dim oMail As Outlook.MailItem
Set oMail = ActiveExplorer.Selection.Item(1)
Dim strFrom As String
strFrom = oMail.SenderName
Dim strSubject As String
strSubject = oMail.ConversationTopic
Dim myOlApp As New Outlook.Application
Set myOlApp.ActiveExplorer.CurrentFolder = ns.GetDefaultFolder(olFolderInbox)
Dim txtSearch As String
txtSearch = "[Konversation]:=""" & strSubject & """"
myOlApp.ActiveExplorer.Search txtSearch, olSearchScopeAllFolders
' Problem occurs below, since the code keeps running but the search results haven't loaded yet.
myOlApp.ActiveExplorer.SelectAllItems
Dim i As Long
For i = ActiveExplorer.Selection.Count To 1 Step -1
Dim Item As MailItem
Set Item = ActiveExplorer.Selection.Item(i)
Debug.Print Item.Subject, Item.Sender, Item.Parent.FolderPath
Next
Set ns = Nothing
Set oMail = Nothing
Set myOlApp = Nothing
Set Item = Nothing
End Sub
Try to use Application.AdvancedSearch instead - it exposes Application.AdvancedSearchComplete event.
The Explorer.Search method is used to perform a Microsoft Instant Search on the current folder displayed in the Explorer using the given Query. Basically, it will use Outlook UI for searching items and the result is visible in Outlook. The functionality of Explorer.Search is analogous to the Search button in Instant Search. It behaves as if the user has typed the query string in the Instant Search user interface and then clicked Search. When calling Search, the query is run in the user interface, and there is no programmatic mechanism to obtain the search results. The Search method does not provide a callback to enable the developer to determine when the search is complete.
Instead, you may find the Find/FindNext or Restrict methods of the Items class helpful. Read more about them in the following articles:
How To: Use Find and FindNext methods to retrieve Outlook mail items from a folder (C#, VB.NET)
How To: Use Restrict method to retrieve Outlook mail items from a folder
Also you may consider using the AdvancedSearch method of the Application class helpful. The key benefits of using the AdvancedSearch method in Outlook are:
The search is performed in another thread. You don’t need to run another thread manually since the AdvancedSearch method runs it automatically in the background.
Possibility to search for any item types: mail, appointment, calendar, notes etc. in any location, i.e. beyond the scope of a certain folder. The Restrict and Find/FindNext methods can be applied to a particular Items collection (see the Items property of the Folder class in Outlook).
Full support for DASL queries (custom properties can be used for searching too). You can read more about this in the Filtering article in MSDN. To improve the search performance, Instant Search keywords can be used if Instant Search is enabled for the store (see the IsInstantSearchEnabled property of the Store class).
You can stop the search process at any moment using the Stop method of the Search class.
The Outlook Object Model provides the AdvanvedSearchComplete event of the Application class. An instance of the Search class containing the search results is passed to the event handler (see the Results property).
See Advanced search in Outlook programmatically: C#, VB.NET for more information.

Looping through specific subfolders in outlook containing a specific string

I want to look for specific items inside specific subfolders in Outlook (macro VBA) that can be in first or second level subfolder, however I cannot make it to work. I have found other questions that loop through all the items in all folders, but not that go through all items in specific subfolders.
fldrname = "Clearing"
Set objNS = GetNamespace("MAPI")
Set ClearingFolders = Outlook.Folders("Clearing", objNS.Folders)
For Each ClearingFolders In objParentFolderCollection
For Each folder In ClearingFolders
If InStr(1, fldrname, folder.Name, vbTextCompare) > 0 Then
{findEmail}
End If
Next folder`
Thanks for your help!
The code below demonstrates how to access every mail item within every folder, and sub-folder to any depth, within a parent folder. It does this by outputting an indented list of items and sub-folders to the Immediate Window. The format of the output is:
ParentFolderName
Date Subject (of mail item within ParentFolder
Date Subject (of mail item within ParentFolder
Date Subject (of mail item within ParentFolder
ChildFolder1Name
Date Subject (of mail item within ChildFolder1Name
Date Subject (of mail item within ChildFolder1Name
GrandchildFolder1Name
Date Subject (of mail item within GrandchildFolder1Name
Date Subject (of mail item within GrandchildFolder1Name
ChildFolder2Name
Date Subject (of mail item within ChildFolder2Name
Date Subject (of mail item within ChildFolder2Name
GrandchildFolder2Name
Date Subject (of mail item within GrandchildFolder2Name
Date Subject (of mail item within GrandchildFolder2Name
GreatgrandchildFolder1Name
Date Subject (of mail item within GreatgrandchildFolder1Name
Date Subject (of mail item within GreatgrandchildFolder1Name
ChildFolder3Name
: : : : :
There are statements within your code I do not understand so I have ignored your code and created my own.
Consider first:
Set Fldr = Session.Folders("StoreName").Folders("TopLevelFolderName")
Your equivalent of this statement is:
Set objNS = GetNamespace("MAPI")
Set Fldr = objNS.Folders("StoreName").Folders("TopLevelFolderName")
With VBA there is often more than one way of achieving the same effect. I prefer Session to objNS. My code so my favourites. Change to your favourite if you wish.
A store is a file on disc that Outlook uses to hold mail items, tasks, appointment items and so on. I assume “Clearing” is the name of a folder and not the name of a store. Your folder pane will look something like this:
StoreName1
Clearing1
Deleted Items
Inbox
Sent Items
StoreName2
Inbox
Clearing2
Sent
Trash
You can have as many stores as you wish. There will be one per email address and perhaps one for archives. When I change computers, I add my old stores to my new Outlook installation, so I have access to all my old emails.
It seems there is always an “Inbox”. Other standard folders change their names from version to version so you might have “Deleted Items” or “Trash” or something else. You can add your own folders wherever you like.
If your “Clearing” is a store, you will need:
Set Fldr = Session.Folders("Clearing")
If your “Clearing” is at the same level as “Inbox” like my “Clearing1”, you will need:
Set Fldr = Session.Folders("StoreName1").Folders("Clearing1")
If your “Clearing” is under “Inbox” like my “Clearing2”, you will need:
Set Fldr = Session.Folders("StoreName2").Folders("Inbox").Folders("Clearing2")
Change my statement to match your system.
Notice that I write:
Dim Fldr As Outlook.Folder
but
Dim ItemCrnt As MailItem
This code runs under Outlook so I do not need to specific Outlook. I could have written Outlook.MailItem but it would not add value because VBA only has one data type named MailItem. However, Outlook as two data types Folder; one for disc folders and one for Outlook folders. Outlook VBA will assume you mean Outlook.Folder when you write Folder but I once got myself into a muddle when I did not specify which Folder I meant. Now, I am always careful to write Outlook.Folder or Scripting.Folder so I will not forget when it is important.
The sub ProcessChild is recursive. There are excellent explanations of recursion on the web so I will not attempt my own explanation now. However, if you are confused, I will add an explanation of my routine.
Now consider:
For InxI = 1 To FldrPrnt.Items.Count
: : :
For InxF = 1 To FldrPrnt.Folders.Count
You have used For Each. I sometimes use For Each but I find For Index more convenient most of the time.
FldrPrnt is the folder whose mail items and sub-folders I wish to access. FldrPrnt.Items gives me access to the items and FldrPrnt.Folders gives me access to the sub-folders.
When I write For InxI = 1 To FldrPrnt.Items.Count, I access the items oldest first. If I had written For InxI = FldrPrnt.Items.Count to 1 Step -1, I would have accessed the items newest first. “Oldest” and “Newest” here does not refer to the date of the item. It refers to the order in which items were added to FldrPrnt.Items. Normally mail items are added in date order so these two orders are the same. However, if you accidentally delete an old mail item then move it back from folder “Deleted Items”, it will become the newest item in the folder.
Often you can write either For InxI = 1 To FldrPrnt.Items.Count or For InxI = FldrPrnt.Items.Count to 1 Step -1. However, if your processing involves moving items to another folder, you must use FldrPrnt.Items.Count to 1 Step -1. With For Index, you are identifying items by their position within FldrPrnt.Items. If you move item 20 to another folder, item 21 becomes item 20, item 22 becomes item 21 and so on. For the next repeat of the loop, you will check the new item 21 not the old item 21. We sometimes get questions where someone is only checking half their items. This is the reason.
Notice If TypeName(FldrPrnt.Items(InxI)) = "MailItem" Then. Not every item is a MailItem. It is essential to check an item’s type before processing it since different items have different properties.
I hope the above, is enough for you to understand my code but ask question is necessary. All my code does is display the received time and subject of each mail item. You will have to replace my Debug.Print statement with whatever code you need to achieve your objectives.
Option Explicit
Sub Main()
Dim Fldr As Outlook.Folder
Set Fldr = Session.Folders("StoreName").Folders("TopLevelFolderName")
Call ProcessChild(Fldr, 0)
End Sub
Sub ProcessChild(ByRef FldrPrnt As Outlook.Folder, ByVal Indent As Long)
Dim InxF As Long
Dim InxI As Long
Dim ItemCrnt As MailItem
Debug.Print Space(Indent * 2) & FldrPrnt.Name
For InxI = 1 To FldrPrnt.Items.Count
If TypeName(FldrPrnt.Items(InxI)) = "MailItem" Then
Set ItemCrnt = FldrPrnt.Items(InxI)
With ItemCrnt
Debug.Print Space(Indent * 2 + 2) & .ReceivedTime & " " & .Subject
End With
End If
Next
For InxF = 1 To FldrPrnt.Folders.Count
If FldrPrnt.Folders(InxF).DefaultItemType = olMailItem Then
Call ProcessChild(FldrPrnt.Folders(InxF), Indent + 1)
End If
Next
End Sub
You need to iterate over all folders recursively:
Private Sub processFolder(ByVal oParent As Outlook.MAPIFolder)
Dim oFolder As Outlook.MAPIFolder
Dim oMail As Outlook.MailItem
For Each oMail In oParent.Items
'Get your data here ...
Next
If (oParent.Folders.Count > 0) Then
For Each oFolder In oParent.Folders
processFolder oFolder
Next
End If
End Sub
Also, you may consider using the AdvancedSearch method of the Application class which performs a search based on a specified DAV Searching and Locating (DASL) search string. The key benefits of using the AdvancedSearch method in Outlook are:
The search is performed in another thread. You don’t need to run another thread manually since the AdvancedSearch method runs it automatically in the background.
Possibility to search for any item types: mail, appointment, calendar, notes etc. in any location, i.e. beyond the scope of a certain folder. The Restrict and Find/FindNext methods can be applied to a particular Items collection (see the Items property of the Folder class in Outlook).
Full support for DASL queries (custom properties can be used for searching too). You can read more about this in the Filtering article in MSDN. To improve the search performance, Instant Search keywords can be used if Instant Search is enabled for the store (see the IsInstantSearchEnabled property of the Store class).
You can stop the search process at any moment using the Stop method of the Search class.
Read more about the AdvancedSearch method in the Advanced search in Outlook programmatically: C#, VB.NET article.
So, maybe you don't need to iterate over all folders and search for specific items there any longer?

Extract email metadata with VBA script

I have a folder full of emails that are a custom message class (iXOS-Archive, related to OpenText Enterprise Archive). Each email has a custom metadata property, visible within Outlook, called "Document Identifier". I'm trying to extract this from the emails using a VBA script. I found a script that extracts common metadata (To, From, Subject etc.) from the emails and writes it to Excel. This works well.
http://spreadsheetpage.com/index.php/tip/getting_a_list_of_file_names_using_vba/
I've tried debugging the script and looking within the email properties, but I cannot find any collection that contains custom metadata.
Does anyone know how I can access the custom metadata through the VBA script?
You will probably not be able to do this using a FileSystemObject or DIR function (as given in the code you linked to, above).
I am unable to test without a suitable example, but this might work:
Bind Outlook to Excel
Open the MSG file in Outlook
Use the Outlook object model to review the MSG file's .ItemProperties
Practically speaking you will set this up in a loop, similar to your example code, but for the sake of testing, try it out on a single file and see if this will help you.
'Requires reference to Outlook object model
Sub foo()
Dim olApp As Outlook.Application
Dim msg As Outlook.MailItem
Dim properties As Outlook.ItemProperties
Dim p As Long
Set olApp = GetObject(, "Outlook.Application")
Set msg = olApp.CreateItemFromTemplate("C:\your filename.msg")
Set properties = msg.ItemProperties
For p = 0 To properties.Count - 1
Debug.Print properties(p).Name
Next
Set msg = Nothing
Set olApp = Nothing
End Sub
This should print the list of ItemProperties in the Immediate window, scroll through that list and check to see if the one you're looking for -- "Document Identifier" -- is included. If so, then this should work and you can modify as needed to do whatever it is you want to do with that information.
I cannot be of further assistance unless you can provide a test/sample version of this email format.
Cheers.

In VBScript, how do I manage "Scripting.FileSystemObjects" like objFSO and objFolder for multiple folders/files?

In VBScript, how do I manage "Scripting.FileSystemObjects" like objFSO and objFolder for multiple folders/files ?
In the "Main" code section, I declare an instance (global) of "Scripting.FileSystemObject"
Set objFSO = CreateObject("Scripting.FileSystemObject")
Then, I perform some operations, like:
If objFSO.FileExists(strOutputFilename) Then
WScript.Echo "Deleting File: " & strOutputFilename
objFSO.DeleteFile strOutputFilename
End If
Then, in a loop, I get a folder, and pass it to a function:
For gintLoop = 0 to (ubound(arraySearchPath))
wscript.echo "Processing folder:" & arraySearchPath(gintLoop)
Set objFolderX = objFSO.GetFolder(arraySearchPath(gintLoop))
Call DoWork (objFolderX, arrayParam1, arrayParam2)
Next
So far everything is clear...
Now, within the function, I do things like:
a) collect filenames from objFolder
Set lobjFolder = objFSO.GetFolder(objFolderX.Path)
Set lcolFiles = lobjFolder.Files
b) check for existance of files in other (unrelated) paths
c) get the size of various files:
lcurInputFileSize = CCur(lobjFile.Size)
d) delete various files
e) open files for reading
For Each lobjFile in lcolFiles
lstrTargetFile = lobjFolder.Path & "\" & lobjFile.Name
Set lobjInputFile = objFSO.OpenTextFile(lstrTargetFile, ForReading)
...
f) open files for writing
Set lobjOutputFile = objFSO.OpenTextFile(strOutputFilename, ForAppending, True)
g) call other subs/functions passing various object
h) recursively call the (same) function to process other folders
For Each lobjSubfolderY in objFolderX.SubFolders
Call DoWork (lobjSubfolderY, arrayParam1, arrayParam2)
Next
My concern is that I need to make sure the various uses of FileSystemObjects like folder paths, open files, etc, are not "Stepped-on" by later uses of FileSystemObjects.
Question 1:
Do I need (or is it advised) to have a seperate instance of "Scripting.FileSystemObject" (objFSO) for "Main" and each (or some) sub/function ?
Question 2:
Similarly, how do I manage the various other objects to avoid loosing data ?
Kevin
Q1: No, you do not need multiple instances of Scripting.FileSystemObject.
The methods on the object are all static.
In fact, the documentation for the Scripting Runtime Reference indicates that the FSO is a singleton, although it does not use the word:
You can create only one instance of the FileSystemObject object, regardless of how many times you try to create another.
from: http://msdn.microsoft.com/en-us/library/2z9ffy99(v=vs.84).aspx
In my experience, calling WScript.CreateObject("Scripting.FileSystemObject") multiple times does not result in an error. Likely the return value on subsequent calls is just a copy of the originally created FSO.
As for your Question 2, I don't get it. I think you are referring to objects that are returned by FSO, objects of type Folder, File, TextStream and so on.
Treat these like any other stateful object. You can have multiple instances, and you need to pass them as stack-based arguments if you want to do recursion.