excel - 如何使用appIE.Document.Body.innerHTML

Question

因此，我尝试检索给定邮政编码的纬度和经度，并尝试使用 VBA 将其放入 Excel 工作表中。我的代码如下:

Private appIE As Object

Function GeoCode(sLocationData As String) As String
'//Dont want to open and close all day long - make once use many
If appIE Is Nothing Then
    CreateIEApp
    '// Creates a new IE App
    '// if = nothing now then there was an error
    If appIE Is Nothing Then
        GeoCode = "Sorry could not launch IE"
        Exit Function
    Else
        '// do nothing
    End If
Else
    '// do nothing
End If
'//clearing up input data
'sLocationData = Replace(sLocationData, ",", " ")
sLocationData = Replace(sLocationData, " ", "+")
sLocationData = Trim(sLocationData)

'//Build URL for Query
sLocationData = "http://maps.google.com/maps/geo?q=%20_" & sLocationData

'// go to the google web service and get the raw CSV data
'// CAUSES PROBLEM AS SPECIFIED BELOW
appIE.Navigate sLocationData

Do While appIE.Busy
    Application.StatusBar = "Contacting Google Maps API..."
Loop

Application.StatusBar = False
On Error Resume Next

'// Parsing
GeoCode = appIE.Document.Body.innerHTML
GeoCode = Mid(GeoCode, InStr(GeoCode, ",") + 1, InStr(GeoCode, "/") - InStr(GeoCode, ",") - 2)

appIE = Nothing
End Function

然后，Google Maps API 返回 JSON 格式的值，如以下链接所示:

http://maps.google.com/maps/geo?q=%20_400012

然后我尝试使用
检索该值 appIE.Document.Body.innerHTML,
并解析该值以获得我想要的数据。然而，当代码点击 appIE.Navigate sLocationData 时，
系统提示我保存一个名为“geo”的文件。当保存并打开为 .txt 文件时，我得到完全相同的 JSON 格式值，但我需要工作表本身中的值。

有办法做到这一点吗？

提前致谢!

Answer 1

该链接在 Firefox 中对我不起作用 - 响应 610。如果我删除空格和下划线，它就会起作用。我不知道为什么 IE 要下载，可能是某些设置告诉它始终下载 JSON 而不是渲染它。无论如何，请考虑使用 MSXML 的 http 请求，而不是自动化 IE。

设置对 Microsoft XML v6.0 或类似版本的引用(VBE - 工具 - 引用)。

Function GeoCode(sLocData As String) As String

    Dim xHttp As MSXML2.XMLHTTP
    Dim sResponse As String
    Dim lStart As Long, lEnd As Long

    Const sURL As String = "http://maps.google.com/maps/geo?q="
    Const sCOOR As String = "coordinates"": " 'substring that we'll look for later

    'send the http request
    Set xHttp = New MSXML2.XMLHTTP
    xHttp.Open "GET", sURL & sLocData
    xHttp.send

    'wait until it's done
    Do
        DoEvents
    Loop Until xHttp.readyState = 4

    'get the returned data
    sResponse = xHttp.responseText

    'find the starting and ending points of the substring
    lStart = InStr(1, sResponse, sCOOR)
    lEnd = InStr(lStart, sResponse, "]")

    GeoCode = Mid$(sResponse, lStart + Len(sCOOR), lEnd - lStart - Len(sCOOR) + 1)

End Function

Sub Test()

    Dim sTest As String

    sTest = GeoCode("400012")

    Debug.Assert sTest = "[ 103.9041520, 1.3222160, 0 ]"

End Sub