Tally Ho: Sending and counting voting responses in Outlook using VBA
December 7, 2009 • JP • No Comments • Rate This Article
A structured and simple way to send out a simple survey using Outlook is to use the voting options available in an email message. You'll see them when you open an email (in Outlook 2003) and click the Options button on the Standard toolbar:
Or you could use InfoPath, or a custom Outlook form for collecting survey responses. Suppose we want to do this programmatically via VBA — send out a voting email, collect the responses and generate a count. First let's look at a simple voting email that is displayed to the end user. Place the following code in a standard module in Outlook:
Dim olApp As Outlook.Application
Dim Msg As Outlook.MailItem
Set olApp = GetOutlookApp
Set Msg = GetOutlookItem(olApp, olMailItem)
With Msg
.VotingOptions = "Yes;No"
.Display
End With
End Sub
Function GetOutlookApp() As Outlook.Application
' returns reference to native Application object
Set GetOutlookApp = Outlook.Application
End Function
Function GetNS(ByRef app As Outlook.Application) As Outlook.NameSpace
Set GetNS = app.GetNamespace("MAPI")
End Function
Function GetOutlookItem(ByRef olApp As Outlook.Application, _
whatItem As OlItemType) As Object
Set GetOutlookItem = olApp.CreateItem(whatItem)
End Function
Function GetItems(olNS As Outlook.NameSpace, _
folder As OlDefaultFolders) As Outlook.Items
Set GetItems = olNS.GetDefaultFolder(folder).Items
End Function
Run VotingButtonsEmail and you'll see an ordinary message appear. But go to Options and you'll see that voting buttons Yes and No were added and will be displayed to the end user.
When received by the recipients, they'll have several ways to respond.
- Click the Infobar while viewing the message in the Preview Pane
- Open the email, go to the Actions menu and click Yes or No
- Open the email and click the Yes or No buttons on the Response toolbar
So now we need a way to process incoming responses and count them. We'll use the ItemAdd event handler to do so. I'll start with the stock event code from Stock Event Code. It will have to be customized to check incoming emails for voting responses, checking which voting response it is, and increasing vote counts accordingly. Here is the modified code that will do so.
Dim votesCount As Long
Dim yesVotes As Long
Dim noVotes As Long
Private Sub Application_Startup()
Dim olApp As Outlook.Application
Dim objNS As Outlook.NameSpace
Set olApp = GetOutlookApp
Set objNS = GetNS(olApp)
Set Items = GetItems(objNS, olFolderInbox)
End Sub
Private Sub Items_ItemAdd(ByVal item As Object)
On Error GoTo ErrorHandler
Dim Msg As Outlook.MailItem
Dim vote As String
Dim votesFolder As Outlook.MAPIFolder
If TypeName(item) <> "MailItem" Then GoTo ProgramExit
Set Msg = item
If Not IsVotingResponse(Msg) Then GoTo ProgramExit
' increment vote total
Call Increment(votesCount)
' determine what the response is and
' increase votecount accordingly
vote = GetVotingResponse(Msg)
Select Case vote
Case "Yes"
Call Increment(yesVotes)
Case "No"
Call Increment(noVotes)
End Select
' comment this out if you don't want a messagebox
' interrupting you every time a response arrives
MsgBox "Total votes: " & votesCount & vbCrLf & _
" 'Yes' votes: " & yesVotes & vbCrLf & _
" 'No' votes: " & noVotes
' mark message as read
Msg.UnRead = False
' move voting response to another folder?
If Not CheckForFolder("Votes") Then
Set votesFolder = CreateSubFolder("Votes")
End If
Msg.Move votesFolder
ProgramExit:
Exit Sub
ErrorHandler:
MsgBox Err.number & " - " & Err.Description
Resume ProgramExit
End Sub
Function GetVotingResponse(ByVal Msg As Outlook.MailItem) _
As String
' returns actual voting response
GetVotingResponse = Msg.VotingResponse
End Function
Function IsVotingResponse(ByVal Msg As Outlook.MailItem) _
As Boolean
' checks voting response and returns true if it isn't an empty string
IsVotingResponse = (Len(GetVotingResponse(Msg)) > 0)
End Function
Function Increment(ByRef amount As Long)
' increases value of long variable by one
' called byref so we don't have to return a value
amount = amount + 1
End Function
There are three Long variables that are used to store the amount of votes received, and the number of Yes and No votes. They are declared at module-level so their values will persist after the event handler completes. Otherwise we'll have no way to save them (unless you want to read/write the amounts to a text file). Note that the event handler assumes that you chose "Yes" and "No" for your voting buttons. If you chose something else, or make up your own (I'm thinking "Hell Yeah" and "No Deal"), you'll have to adjust accordingly.
Lots of functions
There are a lot of helper functions here, so let's go over each one.
I've just started using GetOutlookApp, GetNS, GetOutlookItem and GetItems. GetOutlookApp returns the Outlook.Application object (in Outlook; for a non-Outlook version, check out GetOutlookApp). GetNS takes an Outlook.Application reference and returns its Namespace object. GetOutlookItem takes an Outlook.Application reference and an OlItemType constant, and creates an item in the default folder for that type. GetItems takes a Namespace reference and a OlDefaultFolders constant and returns the Items collection for that folder.
IsVotingResponse and GetVotingResponse work together. GetVotingResponse blindly returns the MailItem.VotingResponse Property for a given message, while IsVotingResponse actually checks if it's a non-empty String (Len > 0).
Increment increases the value of a Long variable by one without having to pass back a value. I like the way it looks better. You could also allow the function to increase the value by different amounts without affecting the rest of the code, like this:
' increases value of long variable by one
' called byref so we don't have to return a value
amount = amount + additional
End Function
This would not change the way the function is called in any of the existing procedures, but any future procedures could call it differently.
CheckForFolder and CreateSubFolder may be found at Look for and create folders programmatically in Outlook (I won't reprint them here; visit that post to grab them).
What It Does
When an item arrives, the event handler first checks to make sure it's an email message. If so, we'll check if the VotingResponse Property is set (using IsVotingResponse as mentioned earlier). If it is a response to a vote request, increment the overall vote count, then determine which option is being voted for and increment the given count for that option.
The message is marked as Read (UnRead = False), and then moved to the Inbox\Votes folder. You can simply comment out this section (or change it) if you don't want this behavior.
The non-Event Handler version
Or perhaps you don't want to auto-process the voting responses, but you've collected them in a folder and want to loop through the messages and count the votes as needed? Enter the TallyVotes procedure. It loops through a given folder and counts all the votes.
' loops through a given folder and counts votes
On Error GoTo ErrorHandler
Dim olApp As Outlook.Application
Dim olNS As Outlook.NameSpace
Dim votesFolder As Outlook.MAPIFolder
Dim votingEmail As Outlook.MailItem
Dim votingEmails As Outlook.Items
Dim votesCount As Long
Dim yesVotes As Long
Dim noVotes As Long
Set olApp = GetOutlookApp
Set olNS = GetNS(olApp)
' choose one:
Set votesFolder = olNS.PickFolder
If votesFolder Is Nothing Then GoTo ProgramExit
' or:
' assumes Inbox\Votes
Set votesFolder = olNS.GetDefaultFolder(olFolderInbox).Folders("Votes")
Set votingEmails = votesFolder.Items
' make sure there are emails present
If votingEmails.Count = 0 Then GoTo ProgramExit
' loop through emails and count votes
For Each votingEmail In votingEmails
If IsVotingResponse(votingEmail) Then
' increment total votes count
Call Increment(votesCount)
' increment individual vote counts
Select Case vote
Case "Yes"
Call Increment(yesVotes)
Case "No"
Call Increment(noVotes)
End Select
End If
Next votingEmail
MsgBox "Total votes: " & votesCount & vbCrLf & _
" 'Yes' votes: " & yesVotes & vbCrLf & _
" 'No' votes: " & noVotes
ProgramExit:
Exit Function
ErrorHandler:
MsgBox Err.Number & " - " & Err.Description
Resume ProgramExit
End Sub
You'll need to grab the following functions: GetOutlookApp, GetNS, GetItems, GetVotingResponse, IsVotingResponse, Increment.
Now go customize VotingButtonsEmail and add it to a toolbar already!
Outlook ·
Rate This Article:
(No Ratings Yet)
Loading ...What now?
Subscribe To The Blog
Email This Article
Follow Me On Twitter
My Facebook Page
Or just keep reading:
I'm just an average guy who writes VBA code for a living. This is my personal blog. Excel and Outlook are my thing, with a sprinkle of Access and Word here and there. Follow this space if you want to learn more about VBA. Keep Reading »
Previous Post: Save Outlook 2003 E-mail Attachments Automatically
Next Post: CC without attachments using Outlook VBA
Speak Your Mind
Tell us what you're thinking...Certain comments (including first-time comments) are subject to moderation and will not appear immediately. Please view the Comment Policy for more information. To post VBA code in your comment, use tags like this: [cc lang='vb']Code goes here[/cc].