从Internet Explorer文本区域(框)复制,但复制到多个单元格中



我目前正试图通过Excel中存储和更新的邮政编码来控制/自动化一个看起来像邮政编码的网站,我的代码运行良好,完成后必须复制数据。在我的一生中,我不知道如何将数据从文本框/区域复制到Excel中,而不将其全部放入一个单元格中("文本到列"也不起作用)。

网站是:http://www.doogal.co.uk/DrivingDistances.php

Sub Geo2()
    Dim sht As Worksheet
    Dim IE As Object
    'Dim ieDoc As HTMLDocument
    Dim Item As Variant
    Dim objElement As Object
    Dim startLoc As String
    Dim endLoc As String
    Dim x As Integer
    Dim objNotes As Object
    Dim strNotes As String
    Dim str As String
    'Dim SignInButton As HTMLInputButtonElement
    Set sht = ThisWorkbook.Sheets("Postcode")
    Set IE = CreateObject("InternetExplorer.Application")
    'Open IE
    IE.Visible = True
    IE.Navigate "http://www.doogal.co.uk/DrivingDistances.php"
    'Wait until site is loaded
    Do While IE.ReadyState <> 4 'READYSTATE_COMPLETE
        DoEvents
    Loop
    IE.Document.getElementbyID("startLocs").Value = "dn1 5pq" 'random postcode       
    IE.Document.getElementbyID("endLocs").Value = "wf12 2fd"   'random postcode            
    IE.Document.getElementsByName("calculateFor").Item(1).Checked = True
    IE.Document.getElementsByName("units").Item(1).Checked = True   
    IE.Document.getElementsByClassName("btn btn-primary").Item(0).Click
------
'Ive tried without having it as a object and using .value but it either comes with only the first line or the entire thing rammed into a string and is unusable
----Code here is the problem-----
        ***Set objNotes = IE.Document.getElementbyID("distances")
        str = objNotes.Value***
---------        
            Do While IE.ReadyState <> 4 'READYSTATE_COMPLETE
            DoEvents
        Loop    
    End Sub

以下VBA函数使用Google Maps Directions API计算两个位置之间的驾驶距离(以米为单位)。该代码是根据barrowc提交的关于这个类似问题的版本进行修改的。

请确保在Excel中添加对Microsoft XML v6.0的引用。

Function getDistance(origin As String, destination As String) As String
Dim xhrRequest As XMLHTTP60
Dim domDoc As DOMDocument60
Dim ixnlDistanceNode As IXMLDOMNode
Dim RequestString As String
Dim API_Key As String
' Insert your own Google Maps Directions API key here
API_Key = "XXXXXX"
' Read the data from the website
Set xhrRequest = New XMLHTTP60
RequestString = "https://maps.googleapis.com/maps/api/directions/xml?origin=" _
 & origin & "&destination=" & destination & "&sensor=false&key=" & API_Key
xhrRequest.Open "GET", RequestString, False
xhrRequest.send
' Copy the results into a format we can manipulate with XPath
Set domDoc = New DOMDocument60
domDoc.LoadXML xhrRequest.responseText
' Select the node called value underneath the leg and distance parents.
' The distance returned is the driving distance in meters.
Set ixnlDistanceNode = domDoc.SelectSingleNode("//leg/distance/value")
getDistance = ixnlDistanceNode.Text
Set ixnlDistanceNode = Nothing
Set domDoc = Nothing
Set xhrRequest = Nothing
End Function

请注意,此代码本身违反了Google API的使用条款"Google Maps Directions API只能与在Google地图上显示结果一起使用;禁止在不显示请求了方向数据的地图的情况下使用方向数据。"1

不是将数据全部放在一个字符串中,而是将字符串Split放入一个数组中,然后像这样循环通过数组:

Set objNotes = IE.Document.getElementbyID("distances")
Dim x as Integer
Dim aDist() as Variant
aDist = Split(objNotes.Value, vbNewLine) 'May need to be vbCr or vbLf or vbCrLf
For x = 0 to Ubound(aDist) - 1
    debug.print aDist(x)
Next x

最新更新