Question

我有一个非常特别的问题，我相信这个问题甚至可能与this question重复，但它从未被回答过。我有一个宏，当我接受特定的电子邮件时运行。它回复电子邮件，其投票选项为＆＃34;已批准＆＃34;或＆＃34;拒绝＆＃34;。当投票选项的收件人以他们的选择作出回应时，收到的选择＆＃34;选择＆＃34;电子邮件没有正文。有没有办法保留身体？

到目前为止我已尝试过这个：

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
    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 = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ"
    fBase36Encode = vbNullString
    Do While lngNumToConvert <> 0
        fBase36Encode = Mid(strAlphabet, lngNumToConvert Mod 36 + 1, 1) & fBase36Encode
        lngNumToConvert = lngNumToConvert \ 36
    Loop
End Function

*编辑*

使用可逆基数64哈希代替：

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 = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"

    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 = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"

    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

VotingOptions响应自定义正文回复

1 个答案: