Question

我有超过3k的地址，我试图在这个网站上找到lat和long http://www.latlong.net/到目前为止，它已经半自动化，但如果在该网站上找不到地址，我必须手动点击＆＃34; OK＆＃34;弹出按钮，使其适用于下一个地址。

此外，我使用F8逐步完成每一行，因为点击了＆＃34; FIND＆＃34;按钮它需要大约一秒钟来获得lat长，所以我不知道如何暂停脚本直到它返回lat长。

Sub LATLONG()

Dim i As Long, fI As Long
Dim ie As New InternetExplorer
Dim strURL As String
Dim html As HTMLDocument
Dim goBtn
Dim btnInput

strURL = "http://www.latlong.net/"

With ie

            .Visible = True
           .navigate strURL

            While .readyState <> 4
                DoEvents
            Wend

For i = 2 To FD.Range("A" & Rows.Count).End(xlUp).Row

    If FD.Range("H" & i) = Empty Or FD.Range("I" & i) = Empty Then

        .document.getElementById("gadres").Value = FD.Range("F" & i) & ", " & FD.Range("D" & i)

        Set goBtn = ie.document.getElementsByClassName("button")

        goBtn(0).Click

        While .readyState <> 4        '<~ This doesn't works
            DoEvents
        Wend

       ' If .document.getElementById("lat").Value = "" Then SendKeys ("{ENTER}") ' Tried to do this but this doesn't works as well

        FD.Range("H" & i) = .document.getElementById("lat").Value
        FD.Range("I" & i) = .document.getElementById("lng").Value

        Debug.Print FD.Range("H" & i) & " = " & .document.getElementById("lat").Value & "," & FD.Range("I" & i) & "=" & .document.getElementById("lng").Value
        .document.getElementById("lng").Value = ""
        .document.getElementById("lat").Value = ""

        End If
Next i

End With
ie.Quit
Set ie = Nothing
MsgBox "Process Complete"

End Sub

任何其他可靠且自动化的方式来获得lat？

Answer 1

您可以轻松访问为您提供坐标的API。我使用的google API运行良好，但它限制了您的请求。我最终得到了来自www.datasciencetoolkit.org的另一个API，但我相信还有很多其他API。

缺点：您必须处理XML或JSON对象。我建议使用GitHub找到的Tim Hall的JSON-Parser。

以下代码为您提供了有关如何从datasciencetoolkit调用API的信息。如果您更改为另一个API，则必须弄清楚JSON结构是如何进行的，并调整代码以读取坐标。

Function GetGeoLocation(adress As String, ByRef latitude As String, ByRef longitude As String) As Integer

' Const MapUrl = "https://maps.googleapis.com/maps/api/geocode/"
Const MapUrl = "http://www.datasciencetoolkit.org/maps/api/geocode/"
Const protocol = "json"      ' "json" or "xml"

GetGeoLocation = -1

longitude = ""
latitude = ""

Dim XMLHttp As Object
Dim strURL As String, strMethod As String, strUser As String
Dim strPassword As String
Dim bolAsync As Boolean
Dim varMessage

' Create Microsoft XML HTTP Object
Set XMLHttp = CreateObject("MSXML2.XMLHTTP")

strMethod = "GET"
strURL = MapUrl & protocol & "?address=" & Trim(adress)

bolAsync = False
strUser = ""
strPassword = ""
varMessage = ""

' Do the request
Call XMLHttp.Open(strMethod, strURL, bolAsync, strUser, strPassword)
Call XMLHttp.send(varMessage)
If XMLHttp.status <> 200 Then Exit Function

' Check result
Dim o As Object
Set o = ParseJson(XMLHttp.responseText)

Dim status As String
status = o.Item("status")
If status <> "OK" Then
    Exit Function
End If

Dim results As Collection
Set results = o.Item("results")
Dim result As Dictionary
Set result = results(1)

longitude = result.Item("geometry").Item("location").Item("lng")
latitude = result.Item("geometry").Item("location").Item("lat")

GetGeoLocation = results.Count
End Function

如何等待脚本完成并单击＆＃34;确定＆＃34; IE浏览器弹出窗口

1 个答案: