How to import a table from web page (with “div class”) to excel?

by

You don’t need a browser to be opened. You can do this with XHR. The url I am using can be found in the network tab via F12 (Dev tools)

If you search that tab after making your request you will find that url and the response has a layout such as:

image link: https://i.stack.imgur.com/C8oLj.png

I loop the rows and the columns to populate a 2d array (table like format) which I write out to the sheet in one go at end.

VBA:

Option Explicit
Public Sub GetExhibitorsInfo()
    Dim ws As Worksheet, results(), i As Long, html As HTMLDocument

    Set ws = ThisWorkbook.Worksheets("Sheet1")
    Set html = New HTMLDocument

    With CreateObject("MSXML2.XMLHTTP")
        .Open "GET", "https://sps.mesago.com/events/en/exhibitors_products/exhibitor-list.html", False
        .setRequestHeader "User-Agent", "Mozilla/5.0"
        .send
        html.body.innerHTML = .responseText
    End With

    Dim rows As Object, html2 As HTMLDocument, columnsInfo As Object
    Dim r As Long, c As Long, j As Long, headers(), columnCount As Long

    headers = Array("name2_kat", "art", "std_nr_sort", "kfzkz_kat", "halle", _
    "sortierung_katalog", "std_nr", "ort_info_kat", "name3_kat", "webseite", _
    "land_kat", "standbez1", "name1_kat")
    Set rows = html.querySelectorAll("[data-entry]")
    Set html2 = New HTMLDocument
    html2.body.innerHTML = rows.item(0).innerHTML
    columnCount = html2.querySelectorAll("[data-entry-key]").length

    ReDim results(1 To rows.length, 1 To columnCount)

    For i = 0 To rows.length - 1
        r = r + 1: c = 1
        html2.body.innerHTML = rows.item(i).innerHTML
        Set columnsInfo = html2.querySelectorAll("[data-entry-key]")
        For j = 0 To columnsInfo.length - 1
            results(r, c) = columnsInfo.item(j).innerText 'columnsInfo.item(j).getAttribute("data-entry-key")
            c = c + 1
        Next
    Next
    With ws
        .Cells(1, 1).Resize(1, columnCount) = headers
        .Cells(2, 1).Resize(UBound(results, 1), UBound(results, 2)) = results
    End With
End Sub

More Related Contents:

  1. How do I click a link on a web page using Excel VBA?
  2. Test or check if sheet exists
  3. How to copy Outlook mail message into excel using VBA or Macros
  4. For Loop not fully cycling in excel VBA [duplicate]
  5. Unique Random Numbers using VBA
  6. Populate unique values into a VBA array from Excel
  7. Excel VBA App stops spontaneously with message “Code execution has been halted”
  8. Save each sheet in a workbook to separate CSV files
  9. Is VBA an OOP language, and does it support polymorphism?
  10. Export each sheet to a separate csv file
  11. Detect if range is empty
  12. Checking if a worksheet-based checkbox is checked
  13. Assign keyboard shortcut to run procedure
  14. Faster way to remove ‘extra’ spaces (more than 1) from a large range of cells using VBA for Excel
  15. Uncheck all checkboxes across entire workbook via CommandButton
  16. return csv file as recordset
  17. VBA workbooks.Close without being prompted to if the user wants to save?
  18. Extract Data from Word Document to an Excel SpreadSheet
  19. VBA equivalent to Excel’s mod function
  20. Copy a selected range to another worksheet
  21. Excel macro – paste only non empty cells from one sheet to another
  22. The MacScript function is not working well in Office for Mac 2016! Any ideas?
  23. Pointers needed for speeding up nested loop macro in VBA
  24. ‘1004’: “The sort reference is not valid.”
  25. Select entire column in table using Excel VBA
  26. Create hyperlink to another sheet
  27. Reducing WithEvent declarations and subs with VBA and ActiveX
  28. Convert Early Binding VBA to Late Binding VBA : Excel to Outlook Contacts
  29. Function Overloading and UDF in Excel VBA
  30. VBA: Modify chart data range

Leave a Comment