VotingOptionsカスタムボディの応答返信

Question

私は非常に特有の問題があります。私はそれがthis questionの複製であるかもしれないと信じていますが、決して答えられませんでした。私は特定の電子メールを受け入れるときに実行されるマクロを持っています。電子メールには、「承認済み」または「却下済み」の投票オプションが付いています。投票オプションの受信者が自分の選択に応じて応答すると、受信した「選択」電子メールには本文がありません。体を保持する方法はありますか？

私はこれまでのところ、これを試してみた：

With objMsg 
    .To = strEmail 
    .HTMLBody = Item.HTMLBody 
    .Subject = "Is This Approved?" 
    .VotingOptions = "Approved;Rejected" 
    .VotingResponse = "Yes" 
    .Attachments.Add Item 
    .Display 
    .Send 
End With 

私はこれが唯一の反応初期の電子メールをもたらすとされていないと考えているが。私はMailItem Objectも見ましたが、.VotingOptionsと.VotingResponse以外の投票のオプションは見当たりませんでした。私はこの目標を達成するのに役立つことができなかった何かがありますか？

さらに、応答に本文を含めることができる限り、投票ボタン以外のアイデア（タスクやそのようなものなど）を公開できます。

アイデアをいただければ幸いです。

Answer 1

上記のコメントで述べたように、私は、メッセージスレッドの返信を追跡できる唯一の方法は、問題に小さなハッシュを追加することだと思います。

Sub TestHash() 
    Dim lDate As Date: lDate = Now 
    Debug.Print DateTimeHash(lDate) 
    Debug.Print DateTimeUnhash(DateTimeHash(lDate)) 
End Sub 

Function DateTimeHash(ByRef lDate As Date) As String 
    Dim Secs As String: Secs = Encode64(60 * (60 * Hour(lDate) + Minute(lDate)) + Second(lDate)) 
    DateTimeHash = "#" & Encode64(DateValue(lDate)) & String(3 - Len(Secs), "0") & Secs & "#" 
End Function 

Function DateTimeUnhash(ByRef Hash As String) As Date 
    Hash = Replace(Hash, "#", "") 
    Dim Days As Long: Days = Decode64(Left(Hash, Len(Hash) - 3)) 
    Dim Secs As Long: Secs = Decode64(Right(Hash, 3)) 
    DateTimeUnhash = DateAdd("d", Days, "0") + DateAdd("s", Secs, "0") 
End Function 

Function Encode64(ByRef Value As Long) As String 
    'Will Convert any Positive Integer to a Base64 String 
    Const Base64 = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz/" 

    Encode64 = IIf(Value > 0, vbNullString, "0") 
    If Encode64 = "0" Then Exit Function 
    Do While Value <> 0 
     Encode64 = Mid(Base64, Value Mod 64 + 1, 1) & Encode64 
     Value = Value \ 64 
    Loop 
End Function 

Function Decode64(ByRef Value As String) As Long 
    'Will Convert any Base64 String to a Positive Integer 
    Const Base64 = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz/" 

    Decode64 = IIf(Value = "", -1, 0) 
    Dim i As Long: For i = 1 To Len(Value) 
     If Decode64 = -1 Then Exit Function ' Error detected with Value string 
     Decode64 = Decode64 * 64 
     Decode64 = IIf(InStr(Base64, Mid(Value, i, 1)) > 0, _ 
      Decode64 + InStr(Base64, Mid(Value, i, 1)) - 1, -1) 
    Next i 
End Function 

：以下代わり可逆ベース64のハッシュを使用して被験者

Sub TestHash() 
    Dim lDate As Date: lDate = Now 
    MsgBox DateTimeHash(lDate) 
End Sub 

Function DateTimeHash(lDate As Date) As String 
    DateTimeHash = "#" & fBase36Encode(DateValue(lDate)) & _ 
    fBase36Encode(60 * (60 * Hour(lDate) + Minute(lDate)) + Second(lDate)) & "#" 
End Function 

Function fBase36Encode(ByRef lngNumToConvert As Long) As String 
    'Will Convert any Positive Integer to a Base36 String 
    fBase36Encode = "0" 
    If lngNumToConvert = 0 Then Exit Function 

    Dim strAlphabet As String: strAlphabet = "ABCDEFGHIJKLMNOPQRSTUVWXYZ" 
    fBase36Encode = vbNullString 
    Do While lngNumToConvert <> 0 
     fBase36Encode = Mid(strAlphabet, lngNumToConvert Mod 36 + 1, 1) & fBase36Encode 
     lngNumToConvert = lngNumToConvert \ 36 
    Loop 
End Function 

* EDIT *

にプレフィックスとして追加する日付と時刻に基づいてハッシュを生成するためのいくつかのコードであります