Excel VBA scraping a nested table

Justas

New Member
Joined
Dec 29, 2014
Messages
2
Hi,

I'm pretty newbie in excel vba. I have this problem:

I want excel to check the availability of an item @ BGS technic

for instance "1195"
I wrote this vba:
Code:
Sub ImportMyData()

Dim IE As New InternetExplorer

IE.Visible = False

IE.navigate "http://www.bgstechnic.com/availability?processed&F1244467957750MNRHTT=_"

Do

DoEvents
Loop Until IE.readyState = READYSTATE_COMPLETE

IE.document.getElementById("item-numbers").Value = "1195"

Set goBtn = IE.document.getElementById("bgs-submit")
goBtn.Click

Do
DoEvents
Loop Until IE.readyState = READYSTATE_COMPLETE




Dim sdd As String
sdd = IE.document.getElementById("availability-results").innerText

MsgBox sdd


End Sub

My problem is, that I only need the part "Item in in stock, more than 50 pcs. available" to be showed/ inserted in excel, but i don't manage to get it, as it has no separate ID.

<thead>
</thead><tbody>
</tbody>

Could anybody help me please?
 

Excel Facts

What is the fastest way to copy a formula?
If A2:A50000 contain data. Enter a formula in B2. Select B2. Double-click the Fill Handle and Excel will shoot the formula down to B50000.
I got my answer in German: 1195 Artikel am Lager, mehr als 50 Stück verfügbar
using the following:

Code:
Option Explicit

Sub ExtractDataFromTables()
    'Modification of
    'http://www.mrexcel.com/forum/excel-questions/259738-general-q-regarding-using-visual-basic-applications-xl-pass-through-ie.html
    
    Dim ie As Object
    Dim myTextField
    Dim doc     'Variant/Object/HTMLDocument
    Dim goBtn
    
    Set ie = CreateObject("InternetExplorer.Application")
    With ie
        .Visible = True
        .Navigate "http://www.bgstechnic.com/availability?processed&F1244467957750MNRHTT=_"
        Do Until .readyState = 4: DoEvents: Loop
        
        ie.document.getElementById("item-numbers").Value = "1195"
        
        Set goBtn = ie.document.getElementById("bgs-submit")
        goBtn.Click
        Stop
        
'        Set myTextField = .Document.all.Item("series_id")
'        myTextField.Value = "ECU11121I"
'        ie.Document.Forms(0).submit
'        Do Until .ReadyState = 4: DoEvents: Loop
'        Do While .Busy: DoEvents: Loop
        Set doc = ie.document
        GetAllTables doc
        .Quit
    End With
    
    Set doc = Nothing
    Set ie = Nothing
    
End Sub

Sub GetAllTables(d)

    Dim e   'Variant/Object/HTMLTable
    Dim t   'Variant/Object/HTMLTable
    Dim tabno As Long
    Dim nextrow As Long
    Dim rng As Range
    Dim r   'Variant/Object/HTMLTableRow
    Dim c   'Variant/Object/HTMLTableCell
    Dim i As Long
    
    For Each e In d.all
        If e.nodeName = "TABLE" Then
            Set t = e
    
            tabno = tabno + 1
            nextrow = nextrow + 1
            Set rng = Range("B" & nextrow)
            rng.Offset(, -1) = "Table " & tabno
            For Each r In t.Rows
                For Each c In r.Cells
                    rng.Value = c.innertext
                    Set rng = rng.Offset(, 1)
                    i = i + 1
                Next c
                nextrow = nextrow + 1
                Set rng = rng.Offset(1, -i)
                i = 0
            Next r
        End If
    Next e
    
    Set rng = Nothing
    Set t = Nothing
    
End Sub
 
Upvote 0
I could not figure out how to change the language via code, but a workaround is to add a
Code:
Stop
line after the
Code:
Do Until .readyState = 4: DoEvents: Loop
line then manually change the language to English and continue.
 
Upvote 0
Thank you. Your code works, but i would like to keep it as simple as possible. and afterwards, the list of articles to be checked will run up to 5000-10000. I did try this:
Code:
sdd = IE.document.getElementsByTagName("tr")(1).getElementsByTagName("td")(1).innerText
. Unfortunately, when running the first time, it gives an runtime error 91. but then by clicking f5 (further running), it presents me the message with the quantity available. Any clou how to solve this?

and if I try to add
Code:
On Error Resume Next
, then i get an empty messagebox....
 
Last edited:
Upvote 0

Forum statistics

Threads
1,214,979
Messages
6,122,552
Members
449,088
Latest member
davidcom

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top