Capturing the web table by VBA without page break

Question

I would like to capture the full set of data within the table within https://mis.twse.com.tw/stock/sblInquiryCap.jsp?lang=en_us#

I was using the codes from the other post but I could only grab the first 10th data due to the page break. Anyway I can amend the code in order to capture the full set of data pls?

Option Explicit
Public Sub MakeSelectionGetData()
    Sheets("Sheet1").Cells.Clear
    Dim ie As New InternetExplorer
    Const url = "https://mis.twse.com.tw/stock/sblInquiryCap.jsp?lang=en_us#"
    Application.ScreenUpdating = False
    With ie
        .Visible = True
        .navigate url

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

        Application.Wait Now + TimeSerial(0, 0, 6)

        Dim nTable As HTMLTable
        Set nTable = .document.getElementById("sblCapTable")
        Dim Headers()
        Headers = Array("Number", "Stock Code", "Real Time Available Volume for SBL Short Sales", "Last Modify")
        Dim TR As Object, TD As Object, r As Long, c As Long

        With ActiveSheet
            r = 2
            c = 1
            Dim TR_col As Object, TD_col As Object
            Set TR_col = nTable.getElementsByTagName("TR")
            .Range("A1").Resize(1, UBound(Headers) + 1) = Headers
            For Each TR In TR_col
                Set TD_col = TR.getElementsByTagName("TD")
                For Each TD In TD_col
                    .Cells(r, c) = TD.innerText
                    c = c + 1
                Next
                c = 1
                r = r + 1
            Next
        End With
        .Quit
    End With
    Application.ScreenUpdating = True
End Sub

score 0 · Answer 1 · answered Feb 12 '20 at 19:54

It is advisable first of all to set the hits per page to 100. Then go through the pagination, which is a bit tricky on the page. I have commented on the macro:

Public Sub MakeSelectionGetData()

  Const url = "https://mis.twse.com.tw/stock/sblInquiryCap.jsp?lang=en_us#"
  Dim ie As Object
  Dim nodeDropdown As Object
  Dim nTable As Object
  Dim TR As Object
  Dim TD As Object
  Dim TR_col As Object
  Dim TD_col As Object
  Dim nodePagination As Object
  Dim nodesCssCurrentNext As Object
  Dim Headers() As Variant
  Dim r As Long
  Dim c As Long
  Dim endOfPagination As Boolean

  Sheets("Sheet1").Cells.Clear
  Headers = Array("Number", "Stock Code", "Real Time Available Volume for SBL Short Sales", "Last Modify")
  ActiveSheet.Range("A1").Resize(1, UBound(Headers) + 1) = Headers
  r = 2
  c = 1

  'Initialize Internet Explorer, set visibility,
  'call URL and wait until page is fully loaded
  Set ie = CreateObject("internetexplorer.application")
  ie.Visible = True
  ie.navigate url
  Do Until ie.readyState = 4: DoEvents: Loop
  Application.Wait Now + TimeSerial(0, 0, 6)

  'Change hits per page to 100
  'Get dropbox from html
  On Error Resume Next
  Set nodeDropdown = ie.document.getElementById("prePage")
  On Error GoTo 0
  'Select the entry with the value 100
  nodeDropdown.selectedIndex = 3
  'Trigger the change event to update the page
  Call TriggerEvent(ie.document, nodeDropdown, "change")
  'Short break to run the update
  Application.Wait Now + TimeSerial(0, 0, 2)

  'Loop through the pagination
  Do
    'Your code
    Set nTable = ie.document.getElementById("sblCapTable").getElementsByTagName("tbody")(0)
    Set TR_col = nTable.getElementsByTagName("TR")
    For Each TR In TR_col
      Set TD_col = TR.getElementsByTagName("TD")
      For Each TD In TD_col
        ActiveSheet.Cells(r, c) = TD.innerText
        c = c + 1
      Next TD
      c = 1
      r = r + 1
    Next TR

    'Click next button in pagination if it's a link
    On Error Resume Next
    Set nodePagination = ie.document.getElementById("Pagination")
    On Error GoTo 0

    'Check for no 'Next' button
    Set nodesCssCurrentNext = nodePagination.getElementsByClassName("current next")
    'While there is no element in the node collection we click the 'Next' button
    If nodesCssCurrentNext.Length = 0 Then
      'Click the 'Next' button
      nodePagination.getElementsByClassName("next")(0).Click
      'Short break to update the next 100 hits
      'All data is in memmory, so there is nothing to load from the server
      Application.Wait Now + TimeSerial(0, 0, 1)
    Else
      'If the node collection is not empty, we reached the end of pagination
      endOfPagination = True
    End If
  Loop Until endOfPagination

  ie.Quit
End Sub

This procedure to trigger the html event to change the dropdown to 100 hits per page:

Private Sub TriggerEvent(htmlDocument As Object, htmlElementWithEvent As Object, eventType As String)

  Dim theEvent As Object

  htmlElementWithEvent.Focus
  Set theEvent = htmlDocument.createEvent("HTMLEvents")
  theEvent.initEvent eventType, True, False
  htmlElementWithEvent.dispatchEvent theEvent
End Sub

Thank you so much for your advice, It works perfectly well. Do you have any advice if we could speed that process up, without using Python Json in the code pls? — Peterlaw2003, Feb 18 '20 at 13:10
It is a VBA macro that has absolutely nothing to do with Python or JSON. All data is loaded when the page is called and this works directly out of VBA with IE only, because no dynamic content can be processed in any other way, except with Selenium and another browser. But that would not be faster either. You could exchange *Application.Wait()* for *Sleep()* to be able to wait less than 1 second while turning pages. But for time reasons I switched to 100 hits per page at the very beginning. More is not possible. I tried it with tricks. I always try it ;-) I wonder why you have a time problem? — Zwenn, Feb 18 '20 at 20:45

Capturing the web table by VBA without page break

1 Answers1