Törölt nick Creative Commons License 2011.10.19 0 0 16329

Ezzel elküzdöttem egy darabig, de szerintem elég jól sikerült. Igaz, nem google-t használ...

B1-be kell beírni a kiindulópontot, B2-be a célállomást, aztán futtatni a makrót, és B3-ba jön (elvileg) az eredmény.

A makró a lekérdezés során megnyitja az Internet Explorert. Az IE ablak felugrását el lehetne kerülni a piros sor törlésével vagy kikommentezésével. Elegánsabb lenne úgy. De az a gond, hogy ha a webhely hibaüzenettel tér vissza, )pl. nemlétező városnév esetén,) akkor a makró nem tudja bezárni az IE ablakot, és mivel az ablak nem látszik, nem tudod bezárni manuálisan sem, csak feladatkezelőből.

 

Sub DistanceQuery()
    Dim IE As Object, Doc As Object
    Dim oFr As Object, oTo As Object, oBut As Object, oSum As Object 'HTMLTableCell
    Dim t As Long, s As String
    Set IE = CreateObject("InternetExplorer.Application")
    IE.Navigate "http://www.terkep24.hu/"
    IE.Visible = True
    While (IE.Busy) Or (IE.ReadyState <> 4)
        'wait until ready
    Wend
    Set Doc = IE.Document
    Set oFr = Doc.getelementbyid("rpA").Children(1)
    Set oTo = Doc.getelementbyid("rpB").Children(1)
    Set oBut = Doc.getelementbyid("routebtn_terv").FirstChild
    
    oFr.Value = Range("B1")
    oTo.Value = Range("B2")
    oBut.Click
    While (IE.Busy) Or (IE.ReadyState <> 4)
        'wait until ready
    Wend
    Set oSum = Doc.getelementbyid("summary")
    While oSum.innerText = ""
        DoEvents
    Wend
    s = oSum.innerText
    s = Replace(s, Chr(13), "")
    s = Replace(s, Chr(10), "")
    t = InStr(s, ":")
    s = Mid(s, t + 1)
    Range("B3") = s
    IE.Quit
End Sub

Előzmény: attillaahun (16289)