Código para procurar latitude e longitude

[Gustavo Martins]

Boa tarde!

Eu usei durante muito tempo um arquivo para encontrar a latitude e longitude de diversos endereços através do VBA. Porém, essa semana começou a ocorrer um erro e não encontro o problema. Poderiam me ajudar?

Sub GetCoordinates()
    Dim i As Integer
    Dim URL As String
    Dim location As String
    Dim latitude As String
    Dim longitude As String
    Dim apikey As String: apikey = "AIzaSyC6g65th8NxOLI7CVdtXPCk2ro4oNm5zE4"
    
    Dim myRequest As XMLHTTP60
    Dim myDomDoc As DOMDocument60
    
    'Limpar resultados
    Coordinates.Range("tblLocations").Range(Cells(1, 2), Cells(Coordinates.Range("tblLocations").Rows.Count, 4)).ClearContents
    
    For i = 1 To Coordinates.Range("tblLocations").Rows.Count
        location = WorksheetFunction.EncodeURL(Coordinates.Range("tblLocations").Cells(i, 1))
        
        If location <> "" Then
            URL = "https://maps.googleapis.com/maps/api/geocode/xml?" & _
                "address=" & location & _
                "&key=" & apikey
            'Debug.Print Len(URL) & " - " & URL
        
            Set myRequest = New XMLHTTP60
            myRequest.Open "GET", URL, False
            myRequest.send
                
            Set myDomDoc = New DOMDocument60
            myDomDoc.LoadXML myRequest.responseText
            
            If myDomDoc.SelectSingleNode("/GeocodeResponse/status").Text = "OK" Then
                latitude = myDomDoc.SelectSingleNode("/GeocodeResponse/result/geometry/location/lat").Text
                longitude = myDomDoc.SelectSingleNode("/GeocodeResponse/result/geometry/location/lng").Text
                
                Coordinates.Range("tblLocations").Cells(i, 2) = 1
                Coordinates.Range("tblLocations").Cells(i, 3) = CDbl(Strings.Replace(latitude, ".", ","))
                Coordinates.Range("tblLocations").Cells(i, 4) = CDbl(Strings.Replace(longitude, ".", ","))
            Else
                'Não foi possível localizar o endereço
                Coordinates.Range("tblLocations").Cells(i, 2) = 0
                Coordinates.Range("tblLocations").Cells(i, 3) = "NOT_FOUND"
                Coordinates.Range("tblLocations").Cells(i, 4) = "NOT_FOUND"
            End If
        End If
    Next i

    Set myRequest = Nothing
    Set myDomDoc = Nothing
End Sub
 

 

[Basole]

Essas consultas do google mps, já não são mais possivel, sem a API Key.