Predict Vietnamese tone in Excel

PredictVietnameseTone.bas

'(VN) Hàm thêm dấu Tiếng Việt & sửa lỗi chính tả cho Excel
'(EN) Predict Vietnamese tone & spell checking for Excel
#If VBA7 Then 'For 64 Bit Systems
    Public Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As LongPtr)
#Else 'For 32 Bit Systems
    Public Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
#End If

Function FormatResponse(response As Object, sentence As String) As String
    Dim wordSuggestion As Dictionary
    Dim lengthDiff As Integer, originalLength As Integer
    Dim startIndex As Integer, endIndex As Integer
    Dim originalText As String, suggestion As String
    
    lengthDiff = 0
    originalLength = UBound(Split(sentence)) + 1
    
    Set response = response("result")("suggestions")
    If IsEmpty(response) Then FormatResponse = sentence

    For Each wordSuggestion In response
        startIndex = wordSuggestion("startIndex")
        endIndex = wordSuggestion("endIndex")
        originalText = wordSuggestion("originalText")
        suggestion = wordSuggestion("suggestion")
        
        sentence = Left(sentence, startIndex - lengthDiff) & suggestion & Mid(sentence, endIndex - lengthDiff + 1)
        lengthDiff = lengthDiff + Len(originalText) - Len(suggestion)
    Next wordSuggestion
    FormatResponse = sentence
End Function

Function PredictVietnameseTone(textRange As range, token As String, Optional delay As Integer = 1000) As Variant()
    Dim objHttp As Object, response As Object
    Dim resultArr() As Variant, i As Integer, j As Integer
    Dim sentence As String, numOfRows As Integer, numOfCols As Integer
    
    'Using Viettel API: https://viettelgroup.ai/document/spell-checking
    Const BASE_URL = "https://viettelgroup.ai/nlp/api/v1/spell-checking"
    numOfRows = textRange.Rows.Count
    numOfCols = textRange.Columns.Count

    If textRange.Count = 1 Then
        ReDim resultArr(1 To 1, 1 To 1)
        resultArr(1, 1) = textRange
    Else
        resultArr = textRange
    End If
    
    Call StartSpeedUp
    Set objHttp = CreateObject("WinHttp.WinHttpRequest.5.1")
    On Error Resume Next
    
    With objHttp
        .Open "POST", BASE_URL, False
        .SetRequestHeader "Content-Type", "application/json"
        .SetRequestHeader "Connection", "keep-alive"
        
        'After login, copy Token in: https://viettelgroup.ai/dashboard/token
        .SetRequestHeader "token", token
        For i = 1 To numOfRows
            For j = 1 To numOfCols
                sentence = Trim(resultArr(i, j))
                If sentence = "" Then Exit For
                .Send "{""sentence"": """ & sentence & """}"
                Sleep delay
                
                If .Status <> 200 Then
                    resultArr(i, j) = .Status & " " & .StatusText
                Else
                    'Import JsonConverter from: https://github.com/VBA-tools/VBA-JSON
                    Set response = JsonConverter.ParseJson(.responseText)
                    resultArr(i, j) = FormatResponse(response, sentence)
                End If
            Next j
        Next i
    End With
    
    On Error GoTo 0
    Call EndSpeedUp
    PredictVietnameseTone = resultArr
End Function

Sub StartSpeedUp()
   With Application
      .Calculation = xlCalculationManual
      .ScreenUpdating = False
      .EnableEvents = False
      .DisplayAlerts = False
      .Cursor = xlWait
   End With
End Sub

Sub EndSpeedUp()
   With Application
      .Calculation = xlCalculationAutomatic
      .ScreenUpdating = True
      .EnableEvents = True
      .DisplayAlerts = True
      .CalculateBeforeSave = True
      .Cursor = xlDefault
   End With
End Sub

Demo: https://www.youtube.com/watch?v=PMtewAQdWz4
VBA JsonConverter: https://github.com/VBA-tools/VBA-JSON
Viettel Spell Checking API: https://viettelgroup.ai/document/spell-checking
Example file: https://drive.google.com/file/d/1NXlkqHxuLLWmyxBEDCo8n81DnHlvvB9U/view?usp=sharing