Сбор данных таблиц веб-страниц с помощью VBA

Попробуйте использовать инструменты разработчика F12 для проверки элементов HTML таблицы, мы видим, что в tbody есть только один тег <table> и один элемент <tbody>, первая строка - это строка заголовка, остальные - строка данных. В строке заголовка мы видим, что элементы <th> не содержат тега <tr>.

 Set hTable = doc.getElementsByTagName("table")
 
 y = 2 'Column B in Excel
 z = 3 'Row 3 in Excel
 For Each tb In hTable
 Set hHead = tb.getElementsByTagName("th")
 For Each hh In hHead
 Set hTR = hh.getElementsByTagName("tr")
 For Each Tr In hTR

Итак, если мы используем приведенный выше код, после нахождения элементов <th> он не будет углубляться в цикл по таблице.

Попробуйте сослаться на следующий код:

Sub Test()
    Dim IE As Object
 
    Sheets("Sheet1").Select
    Dim i As Long, strText As String

    'Dim doc As Object, hTable As Object, hBody As Object, hTR As Object, hTD As Object
    'Dim tb As Object, bb As Object, tr As Object, Td As Object

    Dim y As Long, z As Long, wb As Excel.Workbook, ws As Excel.Worksheet

    'Shell "RunDll32.exe Inetcpl.cpl,ClearMyTracksByProcess 11"

    Set wb = Excel.ActiveWorkbook
    Set ws = wb.ActiveSheet

    Set IE = CreateObject("InternetExplorer.Application")
    my_url = "https://www1.nseindia.com/products/content/equities/equities/eq_security.htm"

    With IE
        .Visible = True
        .navigate my_url
        .Top = 50
        .Left = 530
        .Height = 800
        .Width = 800

    Do Until Not IE.busy And IE.readyState = 4
        DoEvents
    Loop

    End With
    ' Input the userid and password
    'ie.document.getElementById("symbol").Value = Worksheets("Sheet1").Range("B1")
    IE.document.getElementById("symbol").Value = "BAJFINANCE"
    IE.document.getElementById("dateRange").selectedIndex = "4"
    IE.document.getElementById("get").Click
    

    While IE.busy
        DoEvents
    Wend
 
    Set doc = IE.document
     
    y = 2
    z = 3
    
    Dim table As Object, tbody As Object, datarow As Object, thlist As Object, trlist As Object
    
    Application.Wait Now + TimeValue("00:00:02")
    
    'find the tbody. Since it only conatin one table and tbody
    Set tbody = IE.document.getElementsByTagName("table")(0).getElementsByTagName("tbody")(0)
    'find tha theader
    Set thlist = tbody.getElementsByTagName("tr")(0).getElementsByTagName("th")
     
    'Debug.Print thlist.Length
    
    'loop through the header column and capture the value.
    Dim ii As Integer
    For ii = 0 To thlist.Length - 1
        ws.Cells(z, y).Value = thlist(ii).innerText
        y = y + 1
    Next ii
    
    'get all data row
    Set datarow = tbody.getElementsByTagName("tr")
    
    'init the data row index and column index.
    y = 2
    z = 4
    
    'loop through the data row and get all td. and then capture the value.
    Dim jj As Integer
    Dim datarowtdlist As Object
    
    For jj = 1 To datarow.Length - 1
        Set datarowtdlist = datarow(jj).getElementsByTagName("td")
        
        'the x variable is used to set the column index.
        Dim hh As Integer, x As Integer
        x = y
        For hh = 0 To datarowtdlist.Length - 1
            ws.Cells(z, x).Value = datarowtdlist(hh).innerText
            x = x + 1
        Next hh
        z = z + 1
    Next jj
     
    Set IE = Nothing
    
End Sub

Результат: