patternMinor
Manipulating the global address book in Outlook
Viewed 0 times
globaltheaddressmanipulatingbookoutlook
Problem
I am using VBA to manipulate the global address book in Outlook. My method takes a contact and returns a complete list of everyone who reports through that person based on the Outlook org structure.
Unfortunately it takes quite some time to run, even for a single manager. I'm not really sure what is the best way to improve the performance here - it sees the
```
Public Sub printAllReports()
Dim allReports As Collection
Set allReports = New Collection
Dim curLevelReports As Collection
Set curLevelReports = New Collection
Dim nextLevelReports As Collection
Set nextLevelReports = New Collection
Dim myTopLevelReport As ExchangeUser
'this method returns an exchange user from their "outlook name"
Set myTopLevelReport = getExchangeUserFromString("outlook resolvable name here")
'add to both the next level of reports as well as all reports
allReports.Add myTopLevelReport
curLevelReports.Add myTopLevelReport
Dim tempAddressEntries As AddressEntries
Dim newExUser As ExchangeUser
Dim i, j As Integer
'flag for when another sublevel is found
Dim keepLooping As Boolean
keepLooping = False
Dim requireValidUser As Boolean
requireValidUser = False
'this is where the fun begins
Do
'get current reports for the current level
For i = curLevelReports.Count To 1 Step -1
Set tempAddressEntries = curLevelReports.item(i).GetDirectReports
'add all reports (note .Count returns 0 on an empty collection)
For j = 1 To tempAddressEntries.Count
Set newExUser = tempAddressEntries.item(j).getExchangeUser
'isExchangeUserActualEmployee has some short boolean heuristics to make sure
'the user has at least a title and an email address
If (isExchangeUserAct
Unfortunately it takes quite some time to run, even for a single manager. I'm not really sure what is the best way to improve the performance here - it sees the
getDirectReports method takes some time, but, I don't see an easy way to determine if a user has reports prior to calling it first.```
Public Sub printAllReports()
Dim allReports As Collection
Set allReports = New Collection
Dim curLevelReports As Collection
Set curLevelReports = New Collection
Dim nextLevelReports As Collection
Set nextLevelReports = New Collection
Dim myTopLevelReport As ExchangeUser
'this method returns an exchange user from their "outlook name"
Set myTopLevelReport = getExchangeUserFromString("outlook resolvable name here")
'add to both the next level of reports as well as all reports
allReports.Add myTopLevelReport
curLevelReports.Add myTopLevelReport
Dim tempAddressEntries As AddressEntries
Dim newExUser As ExchangeUser
Dim i, j As Integer
'flag for when another sublevel is found
Dim keepLooping As Boolean
keepLooping = False
Dim requireValidUser As Boolean
requireValidUser = False
'this is where the fun begins
Do
'get current reports for the current level
For i = curLevelReports.Count To 1 Step -1
Set tempAddressEntries = curLevelReports.item(i).GetDirectReports
'add all reports (note .Count returns 0 on an empty collection)
For j = 1 To tempAddressEntries.Count
Set newExUser = tempAddressEntries.item(j).getExchangeUser
'isExchangeUserActualEmployee has some short boolean heuristics to make sure
'the user has at least a title and an email address
If (isExchangeUserAct
Solution
Your
Performance-wise, the major hit is going to be hitting the Exchange server, so your code needs to make sure it hits the server only when it's necessary. If that's already the case, chances are you've already got it as good as it gets.
I think your multiple collections and 3-layer deep nested loop approach isn't the easiest way to make your code readable and maintainable, let alone to fine-tune its performance.
HierarchicalUser
The beautiful thing about a language that allows you to define objects, is that doing so actually adds vocabulary to that language, so no matter how lame VBA/VB6 is, with your own objects you can add new nouns, and with your own methods you can add new verbs, and with enough of them you actually end up crafting a language (ok, an API) that's beautiful in its own way.
You have the concept of an ExchangeUser, that can report to another ExchangeUser, and that can have ExchangeUser underlings. I call that a hierarchy, and I'd recommend you encapsulate that
Then you'll need a way to create instances of this class, and populate them. Enter the
Haven't tested any of this, but I believe an approach along those lines could possibly help you reduce the amount of
So your
Nitpicks
printAllReports method does almost everything that's possible to do with the Outlook API (ok maybe not), except printing anything. You basically have what we call a monolith, and that's bad because as your program changes, you are tempted to just keep adding and adding and adding, until the thing becomes an unmanageable, tangled mess. If you're going to call a method printAllReports, give it a signature like this: Sub printAllReports(allReports As Collection), so its intent is clear at first glance - and then make it do one thing; print all reports.Performance-wise, the major hit is going to be hitting the Exchange server, so your code needs to make sure it hits the server only when it's necessary. If that's already the case, chances are you've already got it as good as it gets.
I think your multiple collections and 3-layer deep nested loop approach isn't the easiest way to make your code readable and maintainable, let alone to fine-tune its performance.
HierarchicalUser
The beautiful thing about a language that allows you to define objects, is that doing so actually adds vocabulary to that language, so no matter how lame VBA/VB6 is, with your own objects you can add new nouns, and with your own methods you can add new verbs, and with enough of them you actually end up crafting a language (ok, an API) that's beautiful in its own way.
You have the concept of an ExchangeUser, that can report to another ExchangeUser, and that can have ExchangeUser underlings. I call that a hierarchy, and I'd recommend you encapsulate that
ExchangeUser into your very own HierarchicalUser class, something along those lines:private type tHierarchicalUser
User As ExchangeUser
Superior As HierarchicalUser
Underlings As New Collection
end type
private this As tHierarchicalUser
Option Explicit
Public Property Get User() As ExchangeUser
Set User = this.User
End Property
Public Property Set User(value As ExchangeUser)
Set this.User = value
End Property
Public Property Get Superior() As HierarchicalUser
Set Superior = this.Superior
End Property
Public Property Set Superior(value As HierarchicalUser)
Set this.Superior = value
End Property
Public Property Get Underlings As Collection
'DO NOT return a reference to the encapsulated collection, you'll regret it!
Dim result As New Collection, underling As HierarchicalUser
For Each underling In this.Underlings
result.Add underling
Next
Set Underlings = result
End Property
Public Sub AddUnderling(underling As HierarchicalUser)
Set underling.Superior = Me
this.Underlings.Add underling 'you can use a key here to ensure uniqueness
End Sub
'almost forgot!
Public Function FlattenHierarchy() As Collection
Dim result As New Collection
'traverse whole hierarchy and add all items to a collection that you return
Set FlattenHierarchy = result
End SubThen you'll need a way to create instances of this class, and populate them. Enter the
HierarchicalUserFactory (well, I know I would put that in its own class, but that's just me) - instead of nesting code we're going to be nesting method calls, recursively:Public Function CreateHierarchicalUser(exUser As ExchangeUser) As HierarchicalUser
Dim result As New HierarchicalUser
Dim entry As AddressEntry
Dim underling As ExchangeUser
set result.User = exUser
For Each entry In exUser.GetDirectReports() '<< For Each won't loop if there's nothing in the collection
'if possible, run the isExchangeUserActualEmployee logic off this 'entry' object,
'so you can only call the expensive GetExchangeUser method if needed:
set underling = entry.GetExchangeUser
result.AddUnderling CreateHierarchicalUser(underling) '<<< recursive call!
Next
Set CreateHierarchicalUser = result
End FunctionHaven't tested any of this, but I believe an approach along those lines could possibly help you reduce the amount of
GetExchangeUser calls and thus increase performance... not to mention readability++ :)So your
printAllReports method could possibly look like this now:Public Function getHierarchy(topLevelUserName As String) As HierarchicalUser
Dim factory As New HierarchicalUserFactory
Dim topLevelUser As ExchangeUser
Set topLevelUser = getExchangeUserFromString(topLevelUserName)
Set GetHierarchy = factory.CreateHierarchicalUser(topLevelUser)
End Sub
Public Sub printAllReports(hierarchy As HierarchicalUser)
Dim reports As Collection
Set reports = hierarchy.FlattenHierarchy()
'do all that cool stuff you wanted to do!
End SubNitpicks
- When you declare an object variable and assign it to a
Newinstance on the next line, consider combining the two statements into one:Dim X As New Y.
- When you declare a
Boolean, it's automatically initialized toFalseso your post-declaration assignments are redundant.
- When you evaluate a
Booleanexpressio
Code Snippets
private type tHierarchicalUser
User As ExchangeUser
Superior As HierarchicalUser
Underlings As New Collection
end type
private this As tHierarchicalUser
Option Explicit
Public Property Get User() As ExchangeUser
Set User = this.User
End Property
Public Property Set User(value As ExchangeUser)
Set this.User = value
End Property
Public Property Get Superior() As HierarchicalUser
Set Superior = this.Superior
End Property
Public Property Set Superior(value As HierarchicalUser)
Set this.Superior = value
End Property
Public Property Get Underlings As Collection
'DO NOT return a reference to the encapsulated collection, you'll regret it!
Dim result As New Collection, underling As HierarchicalUser
For Each underling In this.Underlings
result.Add underling
Next
Set Underlings = result
End Property
Public Sub AddUnderling(underling As HierarchicalUser)
Set underling.Superior = Me
this.Underlings.Add underling 'you can use a key here to ensure uniqueness
End Sub
'almost forgot!
Public Function FlattenHierarchy() As Collection
Dim result As New Collection
'traverse whole hierarchy and add all items to a collection that you return
Set FlattenHierarchy = result
End SubPublic Function CreateHierarchicalUser(exUser As ExchangeUser) As HierarchicalUser
Dim result As New HierarchicalUser
Dim entry As AddressEntry
Dim underling As ExchangeUser
set result.User = exUser
For Each entry In exUser.GetDirectReports() '<< For Each won't loop if there's nothing in the collection
'if possible, run the isExchangeUserActualEmployee logic off this 'entry' object,
'so you can only call the expensive GetExchangeUser method if needed:
set underling = entry.GetExchangeUser
result.AddUnderling CreateHierarchicalUser(underling) '<<< recursive call!
Next
Set CreateHierarchicalUser = result
End FunctionPublic Function getHierarchy(topLevelUserName As String) As HierarchicalUser
Dim factory As New HierarchicalUserFactory
Dim topLevelUser As ExchangeUser
Set topLevelUser = getExchangeUserFromString(topLevelUserName)
Set GetHierarchy = factory.CreateHierarchicalUser(topLevelUser)
End Sub
Public Sub printAllReports(hierarchy As HierarchicalUser)
Dim reports As Collection
Set reports = hierarchy.FlattenHierarchy()
'do all that cool stuff you wanted to do!
End SubContext
StackExchange Code Review Q#30876, answer score: 6
Revisions (0)
No revisions yet.