[VBA][Word] Translate selected text using Google Translate

GGTranslateWord.vba

Function Translate(SText As String, Optional FromLang As String = "0", Optional ToLang As String = "th") As String
    ' Translate text using Google Translate
    ' Need References: Microsoft XML 6.0
    Dim p1&, p2&, URL$, resp$, d1$
    Dim xmlhttp As New MSXML2.XMLHTTP60 'Must add references (Tools>References) Microsoft XML v 6.0
    
    Const URL_TEMPLATE$ = "https://translate.google.co.th/m?sl=[from]&tl=[to]&hl=[from]&q="
    Const DIV_RESULT$ = "<div class=""result-container"">"
    URL = URL_TEMPLATE & URLEncode(SText)
    URL = Replace(URL, "[to]", ToLang)
    URL = Replace(URL, "[from]", FromLang)
    xmlhttp.Open "GET", URL, False
    xmlhttp.Send
    resp = xmlhttp.responseText
    'Debug.Print resp
    p1 = InStr(resp, DIV_RESULT)
    If p1 > 0 Then
        p1 = p1 + Len(DIV_RESULT)
        p2 = InStr(p1, resp, "</div>")
        Translate = Mid(resp, p1, p2 - p1)
    End If
        
End Function

Sub ETTranslate()
' Translate selected text to Thai
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = Selection.Text
.Replacement.Text = Translate(Selection.Text)
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll

End Sub

Sub TETranslate()
' Translate selected text to English
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = Selection.Text
.Replacement.Text = Translate(Selection.Text, , "en")
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll

End Sub

Function URLEncode(ByRef txt As String) As String
'URLEncode for translate function
    Dim buffer As String, i As Long, c As Long, n As Long
    buffer = String$(Len(txt) * 12, "%")
 
    For i = 1 To Len(txt)
        c = AscW(Mid$(txt, i, 1)) And 65535
 
        Select Case c
            Case 48 To 57, 65 To 90, 97 To 122, 45, 46, 95  ' Unescaped 0-9A-Za-z-._ '
                n = n + 1
                Mid$(buffer, n) = ChrW(c)
            Case Is <= 127            ' Escaped UTF-8 1 bytes U+0000 to U+007F '
                n = n + 3
                Mid$(buffer, n - 1) = Right$(Hex$(256 + c), 2)
            Case Is <= 2047           ' Escaped UTF-8 2 bytes U+0080 to U+07FF '
                n = n + 6
                Mid$(buffer, n - 4) = Hex$(192 + (c \ 64))
                Mid$(buffer, n - 1) = Hex$(128 + (c Mod 64))
            Case 55296 To 57343       ' Escaped UTF-8 4 bytes U+010000 to U+10FFFF '
                i = i + 1
                c = 65536 + (c Mod 1024) * 1024 + (AscW(Mid$(txt, i, 1)) And 1023)
                n = n + 12
                Mid$(buffer, n - 10) = Hex$(240 + (c \ 262144))
                Mid$(buffer, n - 7) = Hex$(128 + ((c \ 4096) Mod 64))
                Mid$(buffer, n - 4) = Hex$(128 + ((c \ 64) Mod 64))
                Mid$(buffer, n - 1) = Hex$(128 + (c Mod 64))
            Case Else                 ' Escaped UTF-8 3 bytes U+0800 to U+FFFF '
                n = n + 9
                Mid$(buffer, n - 7) = Hex$(224 + (c \ 4096))
                Mid$(buffer, n - 4) = Hex$(128 + ((c \ 64) Mod 64))
                Mid$(buffer, n - 1) = Hex$(128 + (c Mod 64))
        End Select
    Next
    URLEncode = Left$(buffer, n)
End Function

Sub ETTranslateAsComment()
'Translate selected text to Thai in comment.
Selection.Comments.Add Range:=Selection.Range, Text:=Translate(Selection.Text)
End Sub

Sub TETranslateAsComment()
'Translate selected text to English in comment.
Selection.Comments.Add Range:=Selection.Range, Text:=Translate(Selection.Text, , "en")
End Sub