selenium vba extracting data from web table last bit of code to copy text does not work

Question

I have been trying to import the table results from http://avionictools.com/icao.php using example Reg code is N2 my code adds the Reg code and clicks the submit button , but I am unable to copy the results from the table. I wanted the hex code copying to column C

Public Sub regsearch()
Dim LR1, lr2 As Long, i As Long

LR1 = Sheet1.Range("A" & Rows.Count).End(xlUp).Row



Dim data As String

Dim bot As New WebDriver
For i = 2 To 2
Sheet1.Range("A" & i).Copy 'Value is N2

Set clipboard = GetObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
        With clipboard
            .GetFromClipboard
            data = .getText
        End With
        'MsgBox data
bot.Start "chrome", "http://avionictools.com"


bot.Wait 2000
bot.get "/icao.php"
bot.Wait 2000


bot.FindElementByName("data").Click

bot.SendKeys data
bot.Wait 2000
bot.FindElementByXPath("//div/input").Click



bot.Wait 1000


Set Table = bot.getElementsByTagName("table").Item(0)
For Each Tr In Table.getElementsByTagName("tr")
    tdlen = Tr.getElementsByTagName("td").Length
If tdlen > 1 Then
    lr = Sheet2.Range("A" & Rows.Count).End(xlUp).Row + 1
    Sheet1.Range("C" & i).Value = Tr.getElementsByTagName("td").Item(0).innerText
    Sheet1.Range("D" & i).Value = Tr.getElementsByTagName("td").Item(1).innerText
Else

    End If


Next Tr
Application.Wait Now + TimeValue("00:00:04")


Next
End Sub

Did you try my answer? I have added another for your revised question. — QHarr
– QHarr, Commented Nov 26, 2018 at 19:00

QHarr · Accepted Answer · 2018-11-26 22:09:38Z

1

The following seems to work for me

Option Explicit

Public Sub GetInfo()
    Dim IE As New InternetExplorer, clipboard As Object, ws As Worksheet
    Set ws = ThisWorkbook.Worksheets("Sheet1")
    Set clipboard = GetObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")

    With IE
        .Visible = True
        .navigate "http://www.airlinecodes.co.uk/airlcodesearch.asp" '"http://www.airlinecodes.co.uk/airlcoderes.asp"

        While .Busy Or .readyState < 4: DoEvents: Wend

        .document.querySelector("[name=icaocode]").Value = "BAW"
        .document.querySelector("[name=submit]").Click

        While .Busy Or .readyState < 4: DoEvents: Wend

        clipboard.SetText .document.querySelectorAll("table").item(4).outerHTML '.getAttribute("outerHTML")
        clipboard.PutInClipboard

        .Quit
    End With

    ws.Cells(1, 1).PasteSpecial

End Sub

Edit:

In answer to your changed question:

Option Explicit
Public Sub test()
    Dim bot As New ChromeDriver, ws As Worksheet, text As String, i As Long
    Set ws = ThisWorkbook.Worksheets("Sheet1")
    With bot
        .Start
        .get "http://avionictools.com/icao.php"
        For i = 1 To 2
        .FindElementByCss("input[name=data]").SendKeys "N" & CStr(i)
        .FindElementByCss("[type=submit]").submit

        text = .FindElementsByTag("table")(1).FindElementsByTag("tr")(2).FindElementsByTag("td")(1).text
        ws.Cells(i, 1) = Split(text, Chr$(10))(1)
        .FindElementByCss("input[name=data]").Clear
        Next
        .Quit
    End With
End Sub

edited Nov 26, 2018 at 22:09

answered Nov 12, 2018 at 17:36

QHarr

84.5k14 gold badges58 silver badges105 bronze badges

Sign up to request clarification or add additional context in comments.

8 Comments

Mr North Over a year ago

i need to loop when i set a string value for reg and use sendkeys (reg) it does not work

Mr North Over a year ago

This code works but I get all the text , i just want to have the hex code value please ws.Range("B" & i).Value = .FindElementsByTag("table")(1).FindElementsByTag("tr")(2).FindElementsByTag("td")(1).Text

Mr North Over a year ago

thanks , last question if it is possible , is there a way to not include Hex: and just have the code

Mr North Over a year ago

i have changed the code so the webpage is opened before the loop. but i am unable to clear the value from .FindElementByCss("input[name=data]").SendKeys reg. it is keeping the previous value and adds next value so it N1N2 instead of N2 as N1 is not removed , i tried adding sendkey "" at the end before next but it does not work

Mr North Over a year ago

that worked great thanks , is there a way to select an item from the listbox . i want to change it C Number.

|

K.Dᴀᴠɪs · Accepted Answer · 2018-11-12 16:55:13Z

It's somewhat strange to encounter that error, but you can recover from it by resetting your IE object.

For i = 2 To 2

    IE.navigate "http://www.airlinecodes.co.uk/airlcodesearch.asp"
    Do
        DoEvents
        Set IE = GetIE("airlinecodes.co.uk")
    Loop While IE.readyState < READYSTATE_COMPLETE
    Set DOC = IE.document
    DoEvents
    DOC.getElementsByName("icaocode").Item(0).Value = Sheet1.Range("A" & i).Value
    For Each inpt In DOC.getElementsByTagName("input")
        If inpt.Name = "submit" And inpt.Type = "submit" And inpt.Value = "Submit" Then
            inpt.Click
            Do
                DoEvents
                Set IE = GetIE("airlinecodes.co.uk")
            Loop While IE.readyState < READYSTATE_COMPLETE
            Exit For
        End If
    Next inpt

I've updated two loops here, using

Do
    DoEvents
    Set IE = GetIE("airlinecodes.co.uk")
Loop While IE.readyState < READYSTATE_COMPLETE

Which means you will at a minimum run this loop once since I moved the While statement to the bottom - what this will do is it will continuously reset your IE object until the page is loaded - again, this is not something you will always encounter when scraping webpages, it's certainly strange though.

You will also need to add the following sub routine to your module as well - this is what's going to reset your IE object:

Function GetIE(sLocation As String) As InternetExplorer

    Dim objShell As Object, objShellWindows As Object, o As Object
    Dim sURL As String
    Dim RetVal As InternetExplorer

    Set RetVal = Nothing
    Set objShell = CreateObject("shell.application")
    Set objShellWindows = objShell.Windows

    For Each o In objShellWindows
        sURL = ""
        On Error Resume Next
        sURL = o.document.Location
        On Error GoTo 0
        If sURL Like "*" & sLocation & "*" Then
            Set RetVal = o
            Exit For
        End If
    Next o

    Set GetIE = RetVal

End Function

Collectives™ on Stack Overflow

selenium vba extracting data from web table last bit of code to copy text does not work

2 Answers 2

8 Comments

Comments

Your Answer

Hot Network Questions

Collectives™ on Stack Overflow

2 Answers 2

8 Comments

Comments

Your Answer

Sign up or log in

Post as a guest

Related