Gostaria de extrair dados do GoogleMaps? Digamos, CEP, de uma entrada da empresa em uma célula do Excel, através do VBA.
Apesar da idade do BigData, não é provável que o MS Excel desapareça de nosso escritório e computadores particulares. Oferece inúmeras possibilidades para armazenar menores quantidades de dados, prepará-los com clareza e realizar vários cálculos. É por isso que também é interessante acessar várias fontes de dados diretamente do MS Excel. Para consultas automatizadas, o Google (e muitos outros provedores de dados) fornecem uma chamada API da web, ou seja, interface de programação, que também pode ser consultada no Excel usando VBA.
Suponha que no último ano você dirigiu muito visitando clientes de negócios, mas não anotou os dados do hodômetro todas as vezes. Agora você tem uma longa lista de lugares onde esteve e precisa da distância automática entre eles.
Bem, você pode consultar manualmente cada rota no Google Maps e, em seguida, copiá-la para uma planilha no Excel. No entanto, presumimos que tenha passado por tantas rotas no ano passado que o trabalho seja tedioso demais.
Seria muito mais fácil se simplesmente usasse uma fórmula do Excel que consultasse e inserisse automaticamente suas rotas. Felizmente, é possível!
Você só precisa definir uma função VBA que faça exatamente isso. E que tipo de postagem seria essa se você tivesse que escrever isso agora...
Para que este código funcione, você precisa substituir YOUR_KEY por uma chave válida para a API do Google. Para obter uma chave precisa abrir uma conta na plataforma Google Maps. Se o número de consultas não ultrapassar uma determinada cota mensal, será gratuito. A cota exata muda às vezes, mas atualmente pode ser lida neste link.
Outra aplicação seria, por exemplo, se você precisasse das coordenadas geográficas para uma série de endereços. Também existe uma API para isso.
Se estiver prestes a deixar o mundo do Excel para recorrer a ferramentas Data Science como R. No R, essas solicitações de API são geralmente mais fáceis porque a função associada geralmente já existe e você não precisa remendá-la sozinho.
1ª OPÇÃO
Public Function GetDistance (start As String, dest As String)
Dim firstVal As String, secondVal As String, lastVal As String
Let firstVal = "https://www.google.com/maps/dir/Santos,+State+of+S%C3%A3o+Paulo/Tamareiras+Park+Hotel,+R.+Oleg%C3%A1rio+Maciel,+187+-+Centro,+Uberaba+-+MG,+38010-230/R.+S%C3%A3o+Pedro,+70+-+Leblon,+Uberaba+-+MG,+38030-410/@-21.8404124,-49.3805777,7z/data=!3m1!4b1!4m19!4m18!1m5!1m1!1s0x94ce03b97cc7856f:0x3ff3e507b04bbc46!2m2!1d-46.3317787!2d-23.9592201!1m5!1m1!1s0x94bad0369791b18f:0xd52040549cdf031e!2m2!1d-47.9378879!2d-19.7522392!1m5!1m1!1s0x94bad016de4bf999:0xaf75591c4238e716!2m2!1d-47.9343983!2d-19.7688608"
Let secondVal = "&destinations="
Let lastVal = "&mode=car&language=en&sensor=false&key=YOUR_KEY"
Set objHTTP = CreateObject ("MSXML2.ServerXMLHTTP")
Let Url = firstVal & Replace (start, " ", "+") & secondVal & Replace (dest, " ", "+") & lastVal
objHTTP.Open "GET", Url, False
objHTTP.setRequestHeader "User-Agent", "Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.0)"
objHTTP.send ("")
If InStr(objHTTP.responseText, """distance"" : {") = 0 Then GoTo ErrorHandl
Set regex = CreateObject ("VBScript.RegExp"): regex.Pattern = """value"".*?([0-9]+)": regex.Global = False
Set matches = regex.Execute(objHTTP.responseText)
Let tmpVal = Replace (matches(0).SubMatches(0), ".", Application.International (xlListSeparator))
Let GetDistance = CDbl (tmpVal)
Exit Function
ErrorHandl:
Let GetDistance = -1
End Function
2ª OPÇÃO
Option Explicit
Private Sub Worksheet_Change (ByVal Target As Range)
Dim t As Date, gm As New InternetExplorer
Const MAX_WAIT_SEC As Long = 10
If Target.Row = Range ("nom").Row And Target.Column = Range ("nom").Column Then
Let gm.Visible = True
gm.navigate "https://www.google.fr/maps/@-19.7312279,-47.9356511,14z" & Range("nom").Value
While gm.Busy Or gm.readyState <> 4: DoEvents: Wend
Dim elem As Object
Let t = Timer
Do
On Error Resume Next
Set elem = gm.document.querySelector (".section-info-text")
On Error GoTo 0
If Timer - t > MAX_WAIT_SEC Then Exit Do
Loop While elem Is Nothing
If Not elem Is Nothing Then
MsgBox Trim$ (elem.innerText)
'Implement logic to extract post code
End If
gm.Quit
End If
End Sub
Conheça também estes outros códigos:
Série de Livros nut Project
Série DONUT PROJECT 2015
Clique aqui e nos contate via What's App para avaliarmos seus projetos
Nenhum comentário:
Postar um comentário