Question : Outlook voting button no response summary

I asked a question that was very similar to this question before.  The ID of the old question was  ID: 22664290 and Blue Devil Fan helped me with it.  His reponse was exactly what I was looking for.

Our team used to use voting buttons as an acknowledgement that the email was read.  The emails were sent out to groups of people who needed to know about a change in the organization.  We kept the emails that were sent out and used the tracking tab as records that the people had acknowledged the change.  It took us about a year but we realized that this was ineffective because many people did not acknowlege.  Now we have over 100 emails with missing acknowledgements.

The emails would be sent out with the subject of the change as the subject line of the email.  What I am looking for is a macro that can summarize what the subject of the email was and who did not acklowedge.  We can then go back and find out who needs to perform a retroactive acknowledgement of the change.

We stored all the emails as .msg files in a specific directory.  Can someone please help with writing a macro that can search for voting button emails and create a summary of the subject lines and below each subject line create a list of those who did not acknoweledge?  If necessary I can send a few examples of these emails to someone if they need to play around to get it to work correctly.

Answer : Outlook voting button no response summary

Hi, browneye9000.

Try this.

'This declaration must go at the top of the module.
Private Declare Function ShellExecute Lib "shell32.dll" _
  Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, _
  ByVal lpFile As String, ByVal lpParameters As String, _
  ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long

Sub CheckForVotes()
    Dim olkItem As Outlook.MailItem, _
        olkRecipient As Outlook.Recipient, _
        strFolder As String, _
        strFileName As String, _
        objFSO As Object, _
        objFile As Object
    'Change the folder path on the following line as needed
    strFolder = "C:\eeTesting\"
    strFileName = Dir(strFolder & "*.msg")
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    'Change the output filename and path as desired
    Set objFile = objFSO.CreateTextFile(strFolder & "No Responses.txt", True)
    Do Until strFileName = ""
        ShellExecute 0&, "open", strFolder & strFileName, 0&, 0&, 0&
        Do Until Application.Inspectors.Count = 1
            DoEvents
        Loop
        Set olkItem = Application.ActiveInspector.CurrentItem
        objFile.WriteLine "Message: " & olkItem.Subject
        For Each olkRecipient In olkItem.Recipients
            If olkRecipient.TrackingStatus <> olTrackingReplied Then
                objFile.WriteLine "  - " & olkRecipient.Name
            End If
        Next
        olkItem.Close olDiscard
        strFileName = Dir
    Loop
    objFile.Close
    Set objFile = Nothing
    Set objFSO = Nothing
    Set olkRecipient = Nothing
    Set olkItem = Nothing
End Sub