如何从网页(带有“div类")导入表格到excel? [英] How to import a table from web page (with "div class") to excel?

问题描述

我正在尝试将参展商和国家/地区列表导入到 Excel

我循环行和列以填充二维数组(类似于表格的格式)，我将其一次性写入工作表.

<小时>

VBA:

选项显式公共子 GetExhibitorsInfo()Dim ws As Worksheet, results(), i As Long, html As HTMLDocumentSet ws = ThisWorkbook.Worksheets("Sheet1")设置 html = 新建 HTMLDocument使用 CreateObject("MSXML2.XMLHTTP").打开GET"，https://sps.mesago.com/events/en/exhibitors_products/exhibitor-list.html"，假.setRequestHeader "用户代理", "Mozilla/5.0".发送html.body.innerHTML = .responseText结束于Dim 行作为对象，html2 作为 HTMLDocument，列信息作为对象Dim r As Long, c As Long, j As Long, headers(), columnCount As Longheaders = 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")设置行 = html.querySelectorAll("[数据条目]")设置 html2 = 新建 HTMLDocumenthtml2.body.innerHTML = rows.item(0).innerHTMLcolumnCount = html2.querySelectorAll("[data-entry-key]").lengthReDim 结果(1 To rows.length, 1 To columnCount)对于 i = 0 到 rows.length - 1r = r + 1:c = 1html2.body.innerHTML = rows.item(i).innerHTML设置 columnsInfo = html2.querySelectorAll("[data-entry-key]")对于 j = 0 到 columnsInfo.length - 1结果(r, c) = columnsInfo.item(j).innerText 'columnsInfo.item(j).getAttribute("data-entry-key")c = c + 1下一个下一个与 ws.Cells(1, 1).Resize(1, columnCount) = 标题.Cells(2, 1).Resize(UBound(results, 1), UBound(results, 2)) = 结果结束于结束子

I'm trying to import to Excel a list of exhibitors and countries from this webpage and I'm not getting it.

Can Someone help me?

I have tried the methods listed in this forum and doesn't work.

Sub test()

    Dim objIE As Object
    Dim hmtl As HTMLDocument

    Dim elements As IHTMLElementCollection

    Set objIE = New InternetExplorer
    objIE.Visible = True

    objIE.navigate "https://sps.mesago.com/events/en/exhibitors_products/exhibitor-list.html"

    Application.StatusBar = "Loading, Please wait..."

    While objIE.Busy
        DoEvents
    Wend
    Do
    Loop Until objIE.readyState = READYSTATE_COMPLETE

    Application.StatusBar = "Importing data..."

    Set html = objIE.document

    'I try differents types and name - ByClassName("..."), ByTagName("..."), ...
    Set elements = html.getElementsByClassName("list") 

    For i = 0 To elements.Length - 1
         Sheet1.Range("A" & (i + 1)) = elements(i).innerText
    Next i

    objIE.Quit
    Set objIE = Nothing

    Application.StatusBar = ""

End Sub

Sorry about my English.

解决方案

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

这篇关于如何从网页(带有“div类")导入表格到excel?的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！