スクリプトが終了するのを待ち、IEのポップアップで「OK」をクリックする方法

Question

私はこのサイトから緯度および経度を検索しようとしている3kのアドレスを持っています http://www.latlong.net/これまでのところ、そのサイトにアドレスが返されない場合は、手動で「OK」ポップアップボタンをクリックして次のアドレスに対して正しく動作させる必要があります。

また、「FIND」ボタンをクリックした後に緯度を長くするには約2秒かかるので、F8を使用して各行をステップ実行していますので、緯度が長くなるまでどのようにスクリプトを一時停止できますかわかりません。

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 

緯度を長くする他の信頼できる自動化された方法はありますか？

Answer 1

座標を提供するAPIに簡単にアクセスできます。私は非常にうまく動作するGoogle APIを使っていましたが、リクエストが制限されていました。私はwww.datasciencetoolkit.orgから別の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