How to export Voting Results with user names and their responses

[marimar02]

Hello,

I came across an article named "How to Quickly Export Voting Statistics from an Outlook Email to an Excel Worksheet" and it's almost what I'm looking for.

I'd like the macro to actually list the user names and/or email addresses and their responses. I realize I can do this manually but would like to automate if possible since I send emails with voting buttons daily as part of audit requirements.

Thanks much...

 

[Diane Poremsky]

Do you have a link to the article? Manually getting the stats includes the names and responses so getting the name should not be a problem:
Diane Poremsky Yes: 1/28/2020 7:55 AM
EMO Maybe: 1/28/2020 7:57 AM

 

[marimar02]

Do you have a link to the article? Manually getting the stats includes the names and responses so getting the name should not be a problem:
Diane Poremsky Yes: 1/28/2020 7:55 AM
EMO Maybe: 1/28/2020 7:57 AM

Hi and Thank you. Here is the link: Export Voting Button Stats

 

[Diane Poremsky]

I wanted to test it in an easier-to-do simple list. Will write it to Excel next.

For this format:

I'm only getting the name right now, because with Exchange accounts, you need to look up the SMTP, else you get an ugly x500:
EMO - /o=ExchangeLabs/ou=Exchange Administrative Group (FYDIBOHF23SPDLT)/cn=Recipients/cn=99b63d44b5d04d57b797537286c1e165-emo - Maybe

Using this line:
strStatus = objRecipient.Name & " - " & objRecipient.Address & " - " & objRecipient.AutoResponse & vbCrLf & strStatus

If you need the time they voted: objRecipient.TrackingStatusTime

Sub GetVoteResults()
    Dim objMail As Outlook.MailItem
    Dim objRecipient As Outlook.Recipient
    Dim objVoteDictionary As Object
    Dim varVotingCounts As Variant
    Dim varVotingOptions As Variant
    Dim varVotingOption As Variant
    Dim i As Long
Dim strStatus As String
Dim ListVotes As MailItem

    Set objMail = Application.ActiveExplorer.Selection(1)

    Set objVoteDictionary = CreateObject("Scripting.Dictionary")
    'get the default voting options
    varVotingOptions = Split(objMail.VotingOptions, ";")
    'Add the voting responses to the dictionary
    For Each varVotingOption In varVotingOptions
        objVoteDictionary.Add varVotingOption, 0
    Next
    'Add a custom voting response - "No Reply"
    objVoteDictionary.Add "No Reply", 0

    'Process the all voting responses
    For Each objRecipient In objMail.Recipients
        If objRecipient.TrackingStatus = olTrackingReplied Then
           If objVoteDictionary.Exists(objRecipient.AutoResponse) Then
                 strStatus = objRecipient.Name & " - " & objRecipient.AutoResponse & vbCrLf & strStatus
           End If
        Else
           objVoteDictionary.Item("No Reply") = objVoteDictionary.Item("No Reply") + 1
          strStatus = objRecipient.Name & " - No Reply" & vbCrLf & strStatus

        End If
    Next
   
Set ListVotes = Application.CreateItem(olMailItem)
With ListVotes
.Subject = "Vote Results: " & objMail.Subject
  .Body = strStatus & vbCrLf
  .Display

End With

End Sub

 

[Diane Poremsky]

An excel version - the code code probably be a little cleaner, but it works in my test. And there is probably a better way to grab the names and votes instead of creating a string then splitting it into rows and columns.

Sub ExportVotingStatisticsExcel()
    Dim objMail As Outlook.MailItem
    Dim objRecipient As Outlook.Recipient
    Dim objVoteDictionary As Object
    Dim varVotingCounts As Variant
    Dim varVotingOptions As Variant
    Dim varVotingOption As Variant
    Dim i As Long
    Dim objExcelApp As Excel.Application
    Dim objExcelWorkbook As Excel.Workbook
    Dim objExcelWorksheet As Excel.Worksheet
    Dim nRow As Integer
  Dim strStatus As String
  Dim strExcelFile As String

    Set objMail = Application.ActiveExplorer.Selection(1)
 
    'Create a new excel worksheet
    Set objExcelApp = CreateObject("Excel.Application")
    Set objExcelWorkbook = objExcelApp.Workbooks.Add
    Set objExcelWorksheet = objExcelWorkbook.Sheets(1)
 
    'Fill in the predefined values
    With objExcelWorksheet
         .Cells(1, 1) = "Voting Results for Email:"
         .Cells(1, 2) = objMail.Subject
         .Cells(3, 1) = "Voting Options"
         .Cells(3, 2) = "Count"
    End With
 
    Set objVoteDictionary = CreateObject("Scripting.Dictionary")
    'get the default voting options
    varVotingOptions = Split(objMail.VotingOptions, ";")
    'Add the voting responses to the dictionary
    For Each varVotingOption In varVotingOptions
        objVoteDictionary.Add varVotingOption, 0
    Next
    'Add a custom voting response - "No Reply"
    objVoteDictionary.Add "No Reply", 0
 
    'Process the all voting responses
    For Each objRecipient In objMail.Recipients
        If objRecipient.TrackingStatus = olTrackingReplied Then
           If objVoteDictionary.Exists(objRecipient.AutoResponse) Then
              objVoteDictionary.Item(objRecipient.AutoResponse) = objVoteDictionary.Item(objRecipient.AutoResponse) + 1
               strStatus = objRecipient.Name & ";" & objRecipient.AutoResponse & vbCrLf & strStatus

           Else
              objVoteDictionary.Add objRecipient.AutoResponse, 1
              strStatus = objRecipient.Name & ";No Reply" & vbCrLf & strStatus

           End If
        Else
           objVoteDictionary.Item("No Reply") = objVoteDictionary.Item("No Reply") + 1
            strStatus = objRecipient.Name & ";No Reply" & vbCrLf & strStatus
        End If
    Next
 
    'Get the voting options and vote counts
    varVotingOptions = objVoteDictionary.Keys
    varVotingCounts = objVoteDictionary.Items
 
    'Fill in the values in specific cells
    nRow = 4
    For i = LBound(varVotingOptions) To UBound(varVotingOptions)
        With objExcelWorksheet
             .Cells(nRow, 1) = varVotingOptions(i)
             .Cells(nRow, 2) = varVotingCounts(i)
        End With
        nRow = nRow + 1
    Next
    
    nRow = nRow + 1


' split the recipients and their votes

Dim varStatus() As String
Dim varCol As Variant
Dim varRow  As Variant
Dim InxSplit As Long
Dim nCol As Long
 
 varStatus = VBA.Split(strStatus, vbLf)
 
   If UBound(varStatus) > 0 Then
    
    For InxSplit = 0 To UBound(varStatus)
    nRow = nRow + 1
    
' split each row
    varRow = VBA.Split(varStatus(InxSplit), ";")
    nCol = 1

    For Each varCol In varRow
      objExcelWorksheet.Cells(nRow, nCol).Value = varCol
      nCol = nCol + 1
    Next varCol

     Next
   End If
        

    'Save the new Excel file
    objExcelWorksheet.Columns("A:B").AutoFit
    strExcelFile = "l:\Voting Results " & Format(Now, "YYYY-MM-DD hh-mm-ss") & ".xlsx"
    objExcelWorkbook.Close True, strExcelFile

    MsgBox "Complete!", vbExclamation
End Sub

 

[marimar02]

Both are Perfect! Thank you Diane. I can use Outlook and Excel version for different reasons and this provides both. THANK YOU...

Lastly, is there a way to loop through all items in a specific Outlook Mail folder and grab above information in a mass? No worries if too complicated. I'm grateful about the above options.

 

[Diane Poremsky]

Lastly, is there a way to loop through all items in a specific Outlook Mail folder and grab above information in a mass? No worries if too complicated. I'm grateful about the above options.

I don't think it will be complicated - just need to check each each message. I'll take a look at it.

 

[Diane Poremsky]

BTW, it will be fairly easy to run it on a selection of messages that you know are voting. Checking a large folder will be slower.

 

[marimar02]

I can work with selection of messages. That would be a better option so I don't have to separate the messages to different folders. I could just select. Is there an additional code to do so?

 

[Diane Poremsky]

You do need a little more code. The basics is at Working with All Items in a Folder or Selected Items - but as soon a macro I'm testing stops, I'll add it to the macro and post it here.

 

[Diane Poremsky]

You need to add a few lines - 3 at the top, then 5 after the last of the DIM statements. At the very end, before the End Sub, add Next.

Sub GetVoteResults()
  Dim currentExplorer As Explorer
  Dim Selection As Selection
  Dim obj As Object
  
    Dim objMail As Outlook.MailItem
    Dim objRecipient As Outlook.Recipient
    Dim objVoteDictionary As Object
    Dim varVotingCounts As Variant
    Dim varVotingOptions As Variant
    Dim varVotingOption As Variant
    Dim i As Long
 
    Dim strStatus As String
    Dim ListVotes As MailItem
    Dim strCounts As String

    Set currentExplorer = Application.ActiveExplorer
    Set Selection = currentExplorer.Selection

    For Each obj In Selection
        strStatus = ""
    Set objMail = obj  ' Application.ActiveExplorer.Selection(1)

 

[Lewis-H]

Export the voting responses to Excel

1. Open the original message with the voting buttons that you sent. This message is usually located in the Sent Items folder.
2. On the Message tab, in the Show group, click Tracking.
3. Select the responses that you want to copy.
4. Press CTRL+C.
5. Start Excel.
6. Select a cell, and then press CTRL+V.

 

[marimar02]

This is Great! THANK YOU...

I can now export to a folder and run an Excel Macro (which I'm familiar programming with) to summarize all by day onto a single sheet.

Thank you, Thank you...

You need to add a few lines - 3 at the top, then 5 after the last of the DIM statements. At the very end, before the End Sub, add Next.

Sub GetVoteResults()
  Dim currentExplorer As Explorer
  Dim Selection As Selection
  Dim obj As Object
 
    Dim objMail As Outlook.MailItem
    Dim objRecipient As Outlook.Recipient
    Dim objVoteDictionary As Object
    Dim varVotingCounts As Variant
    Dim varVotingOptions As Variant
    Dim varVotingOption As Variant
    Dim i As Long

    Dim strStatus As String
    Dim ListVotes As MailItem
    Dim strCounts As String

    Set currentExplorer = Application.ActiveExplorer
    Set Selection = currentExplorer.Selection

    For Each obj In Selection
        strStatus = ""
    Set objMail = obj  ' Application.ActiveExplorer.Selection(1)

 

[marimar02]

Thank you for this but I was looking for a more of an automated solution using VBA. I appreciate the response anyways.

Export the voting responses to Excel

1. Open the original message with the voting buttons that you sent. This message is usually located in the Sent Items folder.
2. On the Message tab, in the Show group, click Tracking.
3. Select the responses that you want to copy.
4. Press CTRL+C.
5. Start Excel.
6. Select a cell, and then press CTRL+V.