从网页上的 span itemprop 中提取数据答案

【问题标题】：Extracting data from span itemprop on web page从网页上的 span itemprop 中提取数据
【发布时间】：2019-09-02 06:52:30
【问题描述】：

我正在尝试使用 vba 构建网络爬虫。我想将数据（街道地址、邮政编码和地区）从网站提取到工作表，但我遇到了问题。

<li id="ctl00_ctl00_cphMain_cphMainCol_CompanyDetailsInfoData1_liAddress" class="i-location" itemprop="address" itemscope="" itemtype="http://schema.org/Address">

                        <a href="javascript:void(0);" id="ctl00_ctl00_cphMain_cphMainCol_CompanyDetailsInfoData1_aShowOnMap" onclick="openMapTis(517648, 57522, 'KOVINARSTVO IVANETIČ d.o.o.|Omota    8 |Semič');">
                            <span itemprop="street-address">Omota    8</span>, <span itemprop="settlement">Omota</span>, <span itemprop="postal-code">8333</span> <span itemprop="locality">Semič</span>
                        </a>
                    </li>

Sub CompanyData()

Dim ie As InternetExplorer
Dim ht As HTMLDocument

Set ie = New InternetExplorer
ie.Visible = True

'searching web address

ie.navigate ("https://www.bizi.si")

Do Until ie.readyState = READYSTATE_COMPLETE
     DoEvents
Loop

'searching company

Set ht = ie.document

ht.getElementsByTagName("Input").Item("ctl00$Search1$tbSearchWhat").Value = ThisWorkbook.Sheets("Podatki").Range("A1").Value

'click on search result

Set elems = ht.getElementsByTagName("a")

For Each elem In elems
    If elem.className = "i-search" Then
       elem.Click
       Exit For
    End If
Next

Application.Wait (Now + TimeValue("0:00:06"))

Set AllHyperLinks = ht.getElementsByTagName("a")

For Each hyper_link In AllHyperLinks

        If hyper_link.innerText = Range("A1").Value Then
            hyper_link.Click
            Exit For
    End If
Next

Application.Wait (Now + TimeValue("0:00:06"))

gf = ht.getElementsByTagName("span")(0).innerText
gf = Range("B2")



End Sub

我想从网站提取数据（街道地址、邮政编码和地区）到工作表。

【问题讨论】：

你应该更详细地解释你到底有什么问题。您的代码中哪里出现问题？给出的错误消息是什么（如果有）？您自己对问题进行了多少调查（例如，通过在代码中放入 debug.print 语句）？这些将对您的读者有很大帮助，并且意味着他们更有能力 - 并且愿意 - 帮助您..
问题开始于 gf = ht.getElementsByTagName("span")(0).innerText gf = Range("B2") 我想在 Excel 表上提取数据。这句话没问题。
有什么问题？你有错误吗？您是否打印出gf 以查看其中包含的内容？它是你所期望的吗？此外，如果您尝试将数据导出到 Excel，则应该是 Range("B2").value = gf，而不是相反。
我按照你的建议进行了更改 (Range("B2").value = gf) - thanx 现在我得到了一些结果，但这个数据是错误的。 Omota 8 - 工作表上的结果应该是 Omota 8

标签： excel vba web-scraping

【解决方案1】：

页面实际上使用公司名称构造了一个queryString url；因此，您只需将公司名称添加到基本 url 的末尾（而不是在页面上输入）。您也可以只使用 xhr 而不是慢速浏览器（并且 url 对公司名称进行编码）。

我使用css selectors 来匹配地址的适当表格元素。 css 选择器通过HTMLDocument 的querySelector 方法应用。

正则表达式只是对字符串进行一些整理以删除多余的空格。

Internet Explorer：

Option Explicit

Public Sub CompanyData()
    Dim ws As Worksheet, re As Object

    Set re = CreateObject("VBScript.RegExp")
    re.Pattern = "\s{2,}"
    Set ws = ThisWorkbook.Worksheets("Sheet1")

    With CreateObject("InternetExplorer.Application")

        .Visible = True
        .Navigate2 "https://www.bizi.si/iskanje?q=" & ws.Range("A1").Value

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

        ws.Range("B1").Value = re.Replace(Join$(Array(.document.querySelector("td.item a").innerText, .document.querySelector("td.item + td.item").innerText), ", "), Chr$(32))

        .Quit
    End With
End Sub

XHR: xmlhttp request

Public Sub CompanyData2()
    Dim html As HTMLDocument, ws As Worksheet, re As Object

    Set re = CreateObject("VBScript.RegExp")
    re.Pattern = "\s{2,}"
    Set ws = ThisWorkbook.Worksheets("Sheet1")
    Set html = New HTMLDocument
    With CreateObject("MSXML2.XMLHTTP")
        .Open "GET", "https://www.bizi.si/iskanje?q=" & Application.EncodeURL(ws.Range("A1").Value), False
        .send
        html.body.innerHTML = .responseText
    End With
    ws.Range("B1").Value = re.Replace(Join$(Array(html.querySelector("td.item a").innerText, html.querySelector("td.item + td.item").innerText), ", "), Chr$(32))
End Sub

参考资料（VBE > 工具 > 参考资料）：

Microsoft HTML 对象库

【讨论】：