Tallying Votes in Outlook


 

Last week I received an email from a lady named Theresa asking if there’s a way to view voting (i.e. voting button) results without having to open the original message and go to its “Tracking” tab. While Outlook does not offer any other means of viewing the results, we can add that capability with a script and bit of HTML. Here’s how.

Each voting response is stored in the original message as a property called AutoResponse of the respective Recipient object. If Theresa sends a message containing voting buttons to Jane, Bob, and Sally, and all three respond, then Jane’s vote is stored in Jane’s Recipient object, Bob’s in Bob’s Recipient object, and so on. For a script to read the votes it simply needs to look at the AutoResponse property of each Recipient object and tally the results.

Having collected the votes, the script then merges the counts into an HTML template, which it saves to disk. The final step is to display the page in the default browser. In addition to display the voting results, I thought it would be a nice touch to chart them too. To do that, I added a call to Google’s Chart Tools API to include this pie chart.


Requirements.

This code should work with any version of Outlook.

Instructions.

Follow these instructions to add the code to Outlook.

  1. Start Outlook
  2. Press ALT + F11 to open the Visual Basic Editor
  3. If not already expanded, expand Microsoft Office Outlook Objects
  4. If not already expanded, expand Modules
  5. Select an existing module (e.g. Module1) by double-clicking on it or create a new module by right-clicking Modules and selecting InsertModule.
  6. Copy the code from the code snippet box and paste it into the right-hand pane of Outlook’s VB Editor window
  7. Click the diskette icon on the toolbar to save the changes
  8. Close the VB Editor
Sub </a<><>TallyVotes()
    'Declare some constants
    Const HTML_CODE = "<html><head><script type=""text/javascript"" src=""https://www.google.com/jsapi""></script><script type=""text/javascript"">google.load(""visualization"", ""1"", {packages:[""corechart""]});google.setOnLoadCallback(drawChart);function drawChart() {var data = google.visualization.arrayToDataTable([['Options', 'Votes'],%%DATA%%]);var options = {title: 'Chart'};var chart = new google.visualization.PieChart(document.getElementById('chart_div'));chart.draw(data, options);}</script></head><body><h3>Voting Results for Message: %%TITLE%%</h3><br>%%TABLE%%<div id=""chart_div"" style=""width: 900px; height: 500px;""></div></body></html>"
    
    'Declare some variables
    Dim olkMsg As Outlook.MailItem, _
        olkRcp As Outlook.Recipient, _
        dicVotes As Object, _
        objFSO As Object, _
        objFil As Object, _
        objShl As Object, _
        arrVotes As Variant, _
        arrOptions As Variant, _
        varOption As Variant, _
        intCnt As Integer, _
        strBuffer As String, _
        strTable As String, _
        strData As String, _
        strFilename As String
        
    'Iniitialize variables
    strFilename = Environ("TEMP") & "\VotingResults.html"
    Set objFSO = CreateObject("Scripting.FileSystemobject")
    Set objFil = objFSO.CreateTextFile(strFilename)
    Set objShl = CreateObject("WScript.Shell")
    Set dicVotes = CreateObject("Scripting.Dictionary")
    Set olkMsg = Application.ActiveExplorer.Selection(1)
    arrOptions = Split(olkMsg.VotingOptions, ";")
    
    'Add the potential voting responses to the dictionary
    For Each varOption In arrOptions
        dicVotes.Add varOption, 0
    Next
    dicVotes.Add "No Reply", 0
    
    'Process the votes
    For Each olkRcp In olkMsg.Recipients
        If olkRcp.TrackingStatus = olTrackingReplied Then
            If dicVotes.Exists(olkRcp.AutoResponse) Then
                dicVotes.Item(olkRcp.AutoResponse) = dicVotes.Item(olkRcp.AutoResponse) + 1
            Else
                dicVotes.Add olkRcp.AutoResponse, 1
            End If
        Else
            dicVotes.Item("No Reply") = dicVotes.Item("No Reply") + 1
        End If
    Next
    
    'Create the web page containing the results
    arrOptions = dicVotes.Keys
    arrVotes = dicVotes.Items
    For intCnt = LBound(arrOptions) To UBound(arrOptions)
        strTable = strTable & "<tr><td width=""90%"">" & arrOptions(intCnt) & "</td><td width=""10%"">" & arrVotes(intCnt) & "</td></tr>"
        strData = strData & "['" & arrOptions(intCnt) & "', " & arrVotes(intCnt) & "],"
    Next
    strData = Left(strData, Len(strData) - 1)
    strBuffer = Replace(HTML_CODE, "%%TITLE%%", olkMsg.Subject)
    strBuffer = Replace(strBuffer, "%%TABLE%%", "<table>" & strTable & "</table>")
    strBuffer = Replace(strBuffer, "%%DATA%%", strData)
    
    'Write the web page to disk
    objFil.Write strBuffer
    objFil.Close
    
    'Display the page showing the results
    objShl.Run strFilename
    
    'Clean-up
    Set olkMsg = Nothing
    Set olkRcp = Nothing
    Set dicVotes = Nothing
    Set objFSO = Nothing
    Set objFil = Nothing
    Set objShl = Nothing
End Sub

Using the Solution.

To use this solution, open your “Sent Items” folder and select a message you sent that uses voting buttons. Run the macro.

Adding Buttons to Run the Macro with a Single Click.

Running the macro with a single click requires a bit more work. For Outlook 2007 you can add a button to the toolbar. Outlook 2010 uses the ribbon, so for this version we’ll add a button to the Quick Access Toolbar (QAT).

Outlook 2007. Follow these instructions to add toolbar buttons that run the macro.

Outlook 2010. Follow these instructions to add the macro to the QAT.

Revisions.

Revision 1

I put this revision together for Katie who requested that I add a table showing the individual votes grouped by the type of response (e.g. all “Accepts” together followed by all the “Rejects”). The SortDictionary function is not mine. It’s a bit of code I picked up somewhere on the Internet. I’d like to give the original author credit, but unfortunately I don’t remember when I found it or where I found it at.

' declare constants
Const dictKey = 1
Const dictItem = 2

Sub TallyVotes()
    'Declare some constants
    Const HTML_CODE = "<html><head><script type=""text/javascript"" src=""https://www.google.com/jsapi""></script><script type=""text/javascript"">google.load(""visualization"", ""1"", {packages:[""corechart""]});google.setOnLoadCallback(drawChart);function drawChart() {var data = google.visualization.arrayToDataTable([['Options', 'Votes'],%%DATA%%]);var options = {title: 'Chart'};var chart = new google.visualization.PieChart(document.getElementById('chart_div'));chart.draw(data, options);}</script></head><body><h1>Voting Results for Message: %%TITLE%%</h1><br>%%VOTES%%<div id=""chart_div"" style=""width: 900px; height: 500px;""></div><h2>Individual Results</h2><br>%%VOTERS%%</body></html>"
   
    'Declare some variables
    Dim olkMsg As Outlook.MailItem, _
        olkRcp As Outlook.Recipient, _
        dicVotes As Object, _
        dicVoters As Object, _
        objFSO As Object, _
        objFil As Object, _
        objShl As Object, _
        arrVotes As Variant, _
        arrVoters As Variant, _
        arrOptions As Variant, _
        varOption As Variant, _
        intCnt As Integer, _
        strBuffer As String, _
        strVoteTable As String, _
        strVoterTable As String, _
        strData As String, _
        strFilename As String
       
    'Iniitialize variables
    strFilename = Environ("TEMP") & "\VotingResults.html"
    Set objFSO = CreateObject("Scripting.FileSystemobject")
    Set objFil = objFSO.CreateTextFile(strFilename)
    Set objShl = CreateObject("WScript.Shell")
    Set dicVotes = CreateObject("Scripting.Dictionary")
    Set dicVoters = CreateObject("Scripting.Dictionary")
    Set olkMsg = Application.ActiveExplorer.Selection(1)
    arrOptions = Split(olkMsg.VotingOptions, ";")
   
    'Add the potential voting responses to the dictionary
    For Each varOption In arrOptions
        dicVotes.Add varOption, 0
    Next
    dicVotes.Add "No Reply", 0
      
    'Process the votes
    For Each olkRcp In olkMsg.Recipients
        If olkRcp.TrackingStatus = olTrackingReplied Then
            dicVoters.Add olkRcp.Name, olkRcp.AutoResponse
            If dicVotes.Exists(olkRcp.AutoResponse) Then
                dicVotes.Item(olkRcp.AutoResponse) = dicVotes.Item(olkRcp.AutoResponse) + 1
            Else
                dicVotes.Add olkRcp.AutoResponse, 1
            End If
        Else
            dicVotes.Item("No Reply") = dicVotes.Item("No Reply") + 1
            dicVoters.Add olkRcp.Name, "No Reply"
        End If
    Next
    Set dicVoters = SortDictionary(dicVoters, dictItem)
   
    'Create the web page containing the results
    arrOptions = dicVotes.Keys
    arrVotes = dicVotes.Items
    For intCnt = LBound(arrOptions) To UBound(arrOptions)
        strVoteTable = strVoteTable & "<tr><td width=""90%"">" & arrOptions(intCnt) & "</td><td width=""10%"">" & arrVotes(intCnt) & "</td></tr>"
        strData = strData & "['" & arrOptions(intCnt) & "', " & arrVotes(intCnt) & "],"
    Next
    arrVoters = dicVoters.Keys
    arrVotes = dicVoters.Items
    For intCnt = LBound(arrVoters) To UBound(arrVoters)
        strVoterTable = strVoterTable & "<tr><td width=""80%"">" & arrVoters(intCnt) & "</td><td width=""20%"">" & arrVotes(intCnt) & "</td></tr>"
    Next
    strData = Left(strData, Len(strData) - 1)
    strBuffer = Replace(HTML_CODE, "%%TITLE%%", olkMsg.Subject)
    strBuffer = Replace(strBuffer, "%%VOTES%%", "<table>" & strVoteTable & "</table>")
    strBuffer = Replace(strBuffer, "%%VOTERS%%", "<table width=""50%"">" & strVoterTable & "</table>")
    strBuffer = Replace(strBuffer, "%%DATA%%", strData)
   
    'Write the web page to disk
    objFil.Write strBuffer
    objFil.Close
   
    'Display the page showing the results
    objShl.Run strFilename
   
    'Clean-up
    Set olkMsg = Nothing
    Set olkRcp = Nothing
    Set dicVotes = Nothing
    Set objFSO = Nothing
    Set objFil = Nothing
    Set objShl = Nothing
End Sub

  ' Description:
  '   Sorts a dictionary by either key or item
  ' Parameters:
  '   objDict - the dictionary to sort
  '   intSort - the field to sort (1=key, 2=item)
  ' Returns:
  '   A dictionary sorted by intSort
  '
  Function SortDictionary(ByVal objDict, ByVal intSort) As Object


    ' declare our variables
    Dim strDict()
    Dim objKey
    Dim strKey, strItem
    Dim x, y, z


    ' get the dictionary count
    z = objDict.Count


    ' we need more than one item to warrant sorting
    If z > 1 Then
      ' create an array to store dictionary information
      ReDim strDict(z, 2)
      x = 0
      ' populate the string array
      For Each objKey In objDict
          strDict(x, dictKey) = CStr(objKey)
          strDict(x, dictItem) = CStr(objDict(objKey))
          x = x + 1
      Next


      ' perform a a shell sort of the string array
      For x = 0 To (z - 2)
        For y = x To (z - 1)
          If StrComp(strDict(x, intSort), strDict(y, intSort), vbTextCompare) > 0 Then
              strKey = strDict(x, dictKey)
              strItem = strDict(x, dictItem)
              strDict(x, dictKey) = strDict(y, dictKey)
              strDict(x, dictItem) = strDict(y, dictItem)
              strDict(y, dictKey) = strKey
              strDict(y, dictItem) = strItem
          End If
        Next
      Next


      ' erase the contents of the dictionary object
      objDict.RemoveAll


      ' repopulate the dictionary with the sorted information
      For x = 0 To (z - 1)
        objDict.Add strDict(x, dictKey), strDict(x, dictItem)
      Next


    End If

    Set SortDictionary = objDict
  End Function
Advertisements

13 comments on “Tallying Votes in Outlook

    • Hi, Mike.

      I’m assuming that the scenario would be something like this. The user accesses the web site and fills out the from. On submitting the form the server sends the user and email that contains voting buttons. If that’s correct, then that should be possible so long as you have Outlook installed on the web server and there’s an Outlook profile for the account the web site is running under. That said, you might be better off using links in the message too handle the voting rather than using voting buttons. Voting buttons will only work if the user is also using Outlook and by not using voting buttons you won’t require Outlook on the web server.

    • So here’s some more detail. The form on the website is a time off request form that will send to an Outlook user who will either approve or reject the request through the use of voting. I’m just having trouble figuring out how to get the email created from the website to have the vote function integrated so that it shows up to the recipient with the voting option. In this use, a generic voting tally won’t work since it needs to be a reply to the individual person making the request.

      Also, the person submitting the form will be entering their email address as the reply to which is also an Outlook account.

    • Do you already have what you need for creating the email and you just need to know how to add the voting buttons, or do you need both?

    • The email form is already created and functioning, I just need to figure out how to inject the voting functionality into it.

    • Mike,

      Here’s an example of adding voting buttons to a message.

      Sub MessageWithVotingButtons()
          Dim olkMsg As Outlook.MailItem
          Set olkMsg = Application.CreateItem(olMailItem)
          With olkMsg
              .Subject = "Some Subject"
              .HTMLBody = "This message should have three voting buttons: Breakfast, Lunch, and Dinner"
              .VotingOptions = "Breakfast,Lunch,Dinner"
              .Categories = "Voting Buttons Example"
              .Display
          End With
          Set olkMsg = Nothing
      End Sub
      
  1. Is it possible to create a script that would export responses to an Excel spreadsheet and automatically update this as new responses come in? It would need to be possible to link different emails to different spreadsheets (i.e. a vote on a particular thing would link to one spreadsheet containing all the responses, a vote on a different thing would link to a different spreadsheet).

    • Hi, Andy.

      Yes, that’s possible so long as there’s a way to distinguish between the responses in order to determine which spreadsheet to update. There would have to be something unique in either the message body or the subject.

    • Thanks for the quick response David. The subject would be unique and should tie up with the name of the spreadsheet. I’m not too savvy with script, how would I go about setting this up? Thanks in advance.

  2. David – Would it be possible to add the list of recipients, how they responded, and group the names per their response on the HTML template?

    • Hi, Katie.

      Yes, that’s possible. As soon as I can I’ll put together a revision with that capability.

Leave a Reply

Fill in your details below or click an icon to log in:

WordPress.com Logo

You are commenting using your WordPress.com account. Log Out / Change )

Twitter picture

You are commenting using your Twitter account. Log Out / Change )

Facebook photo

You are commenting using your Facebook account. Log Out / Change )

Google+ photo

You are commenting using your Google+ account. Log Out / Change )

Connecting to %s