Jedná se o e-mail Outlooku, ve kterém jsou použita hlasovací tlačítka, kdy každý z příjemců může hlasovat pro některou z více předdefinovaných možností.
Nakonec vyřešeno makrem přímo v outlooku bez excelu, respektive dostat tyto výsledky do excelu už by bylo to nejmenší, ale tato metoda zdá se být i přívětivější než excel :-).
Funkce níže vytvoří HTML text s výsledky, tento lze buď uložit jako html stránku, nebo v mém případě odeslat e-mailem ve formátu html
Public Function HLASOVANI() As String
 Dim myNameSpace As Outlook.NameSpace
 
 Dim myFolder As Outlook.Folder
 
 Dim myItem As Object
 Set myNameSpace = Application.GetNamespace("MAPI")
 
 Set myFolder = myNameSpace.GetDefaultFolder(olFolderSentMail)
 
Dim itmo As Object
Dim cnt As Single
cnt = 0
For Each itmo In myFolder.Items
 cnt = cnt + 1
 If itmo.Subject = "Jedinecny Predmet E-Mailu" Then
 Exit For
 End If
Next
Dim dicVotes As Object
Dim varOption As Variant
Dim arrOptions As Variant
Dim arrVotes As Variant
Dim itmx As MailItem
Set itmx = itmo
arrOptions = Split(itmx.VotingOptions, ";")
Set dicVotes = CreateObject("Scripting.Dictionary")
For Each varOption In arrOptions
 dicVotes.Add varOption, 0
Next
 
dicVotes.Add "Bez odpovědi", 0
 
For Each olkRcp In itmx.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("Bez odpovědi") = dicVotes.Item("Bez odpovědi") + 1
 End If
Next
 arrOptions = dicVotes.Keys
 arrVotes = dicVotes.Items
 
 Dim odpoved As String
 
 odpoved = "<html><table border='0'>"
 For intCnt = LBound(arrOptions) To UBound(arrOptions)
 odpoved = odpoved & "<tr><td width='200'>" & arrOptions(intCnt) & "</td><td align='right'>" & arrVotes(intCnt) & "</td></tr>"
 Next
 odpoved = odpoved & "</table></html>"
 HLASOVANI = odpoved
End Function
Ta podstatná část kódu čerpána z ...
https://techniclee.wordpress.com/2012/10/01/tallying-votes-in-outlook/
Díky
M@
citovat