performance – Calculate the distance in km between two cities in the world in VBA

I have a VBA script that works well, it allows me to calculate the distance between two cities by specifying the country in question based on this site:

http://www.distance2villes.com/recherche?source=

enter image description here

I have sometimes more than 8000 distances to calculate, I would like to know if you have any advice to improve my script and its processing speed for the many distances?

Option Explicit

Function correct(ByVal city As String) As String
    Dim i As Long
    'a) change special cities to French spelling
    Dim cities: cities = Split("ROMA TRIGORIA,S BENEDETTO D TRONTO,AN BREUKELE,MILTON KEY,COPENHAGEN V,PULA CA,051 BALEAL,BRANCA CCH,ST GILLES CROIX DE V,559 PENICHE,WOLKA KRAKOWSKA,L AQUILA,FIUMINCINO,SESTO FLORENTINO,EUPILO", ",")
    Dim cities2: cities2 = Split("Rome,San Benedetto del Tronto,Breukelen,Milton Keynes,Copenhague,Pula,Baleal,Branca,Saint-Gilles-Croix-de-Vie,Peniche,Wola Kosowska,L'Aquila,Fiumicino,Sesto Fiorentino,Eupilio", ",")
    For i = 0 To UBound(cities)
        city = Replace(city, cities(i), cities2(i))
    Next
    'b)remove numeric district suffixes
    Dim tmp: tmp = Split(city, " ")
    If IsNumeric(tmp(UBound(tmp))) Then
        tmp(UBound(tmp)) = "DELETE"
        city = Join(Filter(tmp, "DELETE", False))
    End If
    'c) insert hyphens and apostrophs
    city = Replace(Replace(Replace(UCase(city), " L ", " L'"), " D ", " D'"), " ", "-")
    'd) remove all accents
    Dim chars:     chars = Split("Á À Â Ç É È Ê Î Ï")
    Dim chars2: chars2 = Split("A A A C E E E I I")
    For i = 0 To UBound(chars)
        city = Replace(city, chars(i), chars2(i))
    Next
    'e) return function result
    correct = city
End Function


Sub Distance()
    
    Const DIST1 As String = "http://www.distance2villes.com/recherche?source="
    Const DIST2 As String = "&destination="
    Const DIST3 As String = "distanciaRuta"
    Const wsName As String = "Feuil1"
    
    'Dim w As Object: Set w = CreateObject("WINHTTP.WinHTTPRequest.5.1")
    Dim w As Object: Set w = CreateObject("MSXML2.XMLHTTP")
    Dim h As Object: Set h = CreateObject("htmlfile")
    
    Dim ws As Worksheet: Set ws = ThisWorkbook.Worksheets(wsName)
    Dim rg As Range
    Set rg = ws.Range("A2", ws.Cells(ws.Rows.Count, "A").End(xlUp).Offset(, 2))
    Dim Data As Variant: Data = rg.Value
    
    Dim isFound As Boolean: isFound = True
    Dim i As Long
    Dim Url As String
    Dim S As String
    
    For i = 1 To UBound(Data, 1)
        If Len(Data(i, 1)) > 0 And Len(Data(i, 2)) > 0 Then
          'Line to take into account the city of departure and arrival with its country
            Url = DIST1 & Data(i, 1) & DIST2 & correct(Data(i, 2)) & "%20" & Data(i, 3)
            w.Open "GET", Url, False
            w.Send
            h.body.innerHTML = w.responseText
            On Error GoTo NotFoundError
            S = h.getElementById(DIST3).innerText
            On Error GoTo 0
            If isFound Then
                Data(i, 1) = Replace(Left(S, Len(S) - 3), ",", "")
            Else
                Data(i, 1) = ""
                isFound = True
            End If
        Else
            Data(i, 1) = ""
        End If
    Next
    rg.Columns(1).Offset(, 3).Value = Data
    
    Exit Sub

NotFoundError:
    isFound = False
    Resume Next

End Sub