VBA web data scraping from table

Sub Scrambledata()


    Dim ie As Object, objInputs As Object


    Set ie = CreateObject("InternetExplorer.Application")
    ie.Visible = True
    ie.Navigate "http://www.scramble.nl/military-database/usaf"


    Do While ie.ReadyState <> 4: DoEvents: Loop


    
    ie.Document.getElementById("serial").Value = Sheets("Scramble").Range("A2").Value


   
    Set objInputs = ie.Document.getElementsByTagName("input")
    For Each ele In objInputs
        If ele.Name Like "sbm" Then
            ele.Click
            Exit For
        End If
    Next
    
    
    
    
     End Sub

scr.JPG

I have a value in cell A2 = 03-3114, code above is searching website for that input and returns with results in a table
I am trying to scrape that data back into excel cell, I tried few different ways but so far I have not found working solution

Search for serial 03-3114 returns type = C-17A (third field in the table)
I'd like to import that value into my table in to cell B2,

I was able to find xPath using Firefox Firebug but I dont know what to do next

/html/body/div[1]/div/div[2]/div/div[2]/div[5]/div[2]/div[1]/table/tbody/tr[3]/td[3]/span


any help is appreciated.

Sub Scrambledata()

    Dim ie As Object, objInputs As Object

    Set ie = CreateObject("InternetExplorer.Application")
    ie.Visible = True
    ie.Navigate "http://www.scramble.nl/military-database/usaf"

    Do While ie.readyState <> 4: DoEvents: Loop

    '~~> Get the ID of the textbox where you want to output
    ie.document.getElementById("serial").Value = Sheets("Scramble").Range("A2").Value

    '~~> Here we try to identify the search button and click it
    Set objInputs = ie.document.getElementsByTagName("input")
    For Each ele In objInputs
        If ele.Name Like "sbm" Then
            ele.Click
            Exit For
        End If
    Next
  
 Application.Wait (Now + TimeValue("0:00:02"))
 Sheets("Scramble").Range("B2").Value = ie.document.getElementsByClassName("ScrambleLabel")(11).innerText
    
   
    
    
End Sub

Thank you, Arkadi

Modified code above works for me even with 2 sec delay

Option Explicit

Sub Scrambledata()

    Dim ie As Object, objInputs As Object, URL$, ele As Object
    Set ie = CreateObject("InternetExplorer.Application")
    ie.Visible = 0
    ie.navigate "http://www.scramble.nl/military-database/usaf"


    Do While ie.readyState <> 4: DoEvents: Loop
    
    ie.document.getElementById("serial").Value = Sheets("Scramble").Range("A2").Value
   
    Set objInputs = ie.document.getElementsByTagName("input")
    For Each ele In objInputs
        If ele.Name Like "sbm" Then
            ele.Click
            Exit For
        End If
    Next
    Sheets("Scramble").Range("A" & Rows.Count).End(xlUp).Offset(1) = ie.document.getElementsByTagName("td")(13).innerText
    
End Sub

Sub test()

Const searchUrl = "http://www.scramble.nl/index.php?option=com_mildb&view=search"
Const searchTerm = "03-3114"

Dim dom As HTMLDocument
Set dom = New HTMLDocument

With CreateObject("winhttp.winhttprequest.5.1")
    .Open "POST", searchUrl, False
    .setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
    .send "Itemid=60&af=usaf&serial=" & searchTerm & "&sbm=Search&code=&searchtype=&unit=&cn="
    dom.body.innerHTML = .responseText
End With

MsgBox dom.getElementsByClassName("rowBord")(0).Cells(2).innerText


End Sub

Hi Kyle,
Much better than IE
Where did you get this line

"Itemid=60&af=usaf&serial=" & searchTerm & "&sbm=Search&code=&searchtype=&unit=&cn="
?

@IonutC - A Chrome extension I wrote https://chrome.google.com/webstore/d...nacjapndgmjdoe

@AB33 open the network panel on developer tools when making in the search request and have a look in the request body.

No problem

Erm, it depends on the website. Some will need them all, others will be happy with just a couple - it's more resilient to include them all.

No, the code won't work with late binding - you can't select by class name using late binding. You could re-write that bit, but you'd need to loop through as per the other solutions.

You're hijacking the thread, if you've got any queries on the extension, have a look here http://www.excelforum.com/the-water-...extension.html

Hi Kyle,
Ta again!

Const searchTerm = "03-3114"

how should I change that line to have the value imported from Sheets("Scramble").Range("B2").Value, I am getting "constant expression required" error ?

Dim searchTerm As String
Then

searchTerm = Sheets("Scramble").Range("B2").Value

Sub Scrambledata()

  
Dim searchTerm As String
 

Const searchUrl = "http://www.scramble.nl/index.php?option=com_mildb&view=search"
Const searchTerm = Sheets("Scramble").Range("B2").Value

Dim dom As HTMLDocument
Set dom = New HTMLDocument

With CreateObject("winhttp.winhttprequest.5.1")
    .Open "POST", searchUrl, False
    .setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
    .send "Itemid=60&af=usaf&serial=" & searchTerm & "&sbm=Search&code=&searchtype=&unit=&cn="
    dom.body.innerHTML = .responseText
End With

Sheets("Scramble").Range("C2").Value = dom.getElementsByClassName("rowBord")(0).Cells(2).innerText

   
    
End Sub

@AB33 I added Dim searchTerm As String
, still getting the same error, see modified code

Make sure that the value comes from the right cell. I have it mine on A2

Sub Scrambledata1()

  
Dim searchTerm As String
 

Const searchUrl = "http://www.scramble.nl/index.php?option=com_mildb&view=search"
searchTerm = Sheets("Scramble").Range("A2")

Dim dom As HTMLDocument
Set dom = New HTMLDocument

With CreateObject("winhttp.winhttprequest.5.1")
    .Open "POST", searchUrl, False
    .setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
    .send "Itemid=60&af=usaf&serial=" & searchTerm & "&sbm=Search&code=&searchtype=&unit=&cn="
    dom.body.innerHTML = .responseText
End With

Sheets("Scramble").Range("C2").Value = dom.getElementsByClassName("rowBord")(0).Cells(2).innerText

   
    
End Sub

@AB33 - my error, everything works perfect. Thank you for your help! I learned at lot today.

Another small improvement, if I have few values in column A , how can I loop through column A, so the code
brings data to corresponding rows in column C in one run?

Well, credit should get to Kyle. I am only polishing it.

Sub Scrambledata1()

Dim Cel As Range, ms As Worksheet, dom As HTMLDocument
 
Set ms = Sheets("Scramble")
Const searchUrl = "http://www.scramble.nl/index.php?option=com_mildb&view=search"

   For Each Cel In ms.Range("A2:A" & ms.Range("A" & Rows.Count).End(xlUp).Row).SpecialCells(2)

        Set dom = New HTMLDocument
        
        With CreateObject("winhttp.winhttprequest.5.1")
            .Open "POST", searchUrl, False
            .setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
            .send "Itemid=60&af=usaf&serial=" & Cel & "&sbm=Search&code=&searchtype=&unit=&cn="
            dom.body.innerHTML = .responseText
        End With
    
        Cel.Offset(, 2) = dom.getElementsByClassName("rowBord")(0).Cells(2).innerText

   Next
    
End Sub

@Kyle123 - AB33 is working with me on the code which you came up with, I really appreciate your help, thank you!
@AB33 Big thanks, loop is working like a charm:

Sub ScrambleNavySerial()

Dim Cel As Range, ms As Worksheet, dom As HTMLDocument
 
Set ms = Sheets("Scramble")
Const searchUrl = "http://www.scramble.nl/index.php?option=com_mildb&view=search"

   For Each Cel In ms.Range("A2:A" & ms.Range("A" & Rows.Count).End(xlUp).Row).SpecialCells(2)

        Set dom = New HTMLDocument
        
        With CreateObject("winhttp.winhttprequest.5.1")
            .Open "POST", searchUrl, False
            .setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
            .send "Itemid=60&af=usn&serial=" & Cel & "&sbm=Search&code=&searchtype=&unit=&cn="
            dom.body.innerHTML = .responseText
        End With
    
        Cel.Offset(, 1) = dom.getElementsByClassName("rowBord")(0).Cells(1).innerText
        Cel.Offset(, 2) = dom.getElementsByClassName("rowBord")(0).Cells(2).innerText
        Cel.Offset(, 3) = dom.getElementsByClassName("rowBord")(0).Cells(3).innerText
        Cel.Offset(, 3) = dom.getElementsByClassName("rowBord")(0).Cells(4).innerText
        Cel.Offset(, 4) = dom.getElementsByClassName("rowBord")(0).Cells(5).innerText
     

   Next

    
End Sub