【问题标题】:VBA Grab only Main Table from HTML Web Scrape. not the whole pageVBA 从 HTML Web Scrape 中仅抓取主表。不是整个页面
【发布时间】:2020-10-15 11:19:29
【问题描述】:

我通过使用 excel 复制和粘贴来完成这项工作,而不是通过正确的网络抓取。我有兴趣只从主表中捕获数据,但相反,我会在我的响应中获取所有内容。我怎样才能得到主表?我尝试使用..." Set HTMLTables = HTMLDoc.getElementsByTagName("tbody").Item("3") "

Sub IE_DropDownSelect_and_Click()

Dim ie As New SHDocVw.InternetExplorer
Dim htmlDoc As New MSHTML.HTMLDocument
Dim HTMLTables As MSHTML.IHTMLElementCollection
Dim HTMLTable As MSHTML.IHTMLElement
Dim TableSection As MSHTML.IHTMLElement
Dim TableRow As MSHTML.IHTMLElement
Dim TableCell As MSHTML.IHTMLElement
Dim RowCount As Integer
Dim ColCount As Integer
Dim HTMLa As MSHTML.IHTMLElement  'TagName("a")
Dim HTMLas As MSHTML.IHTMLElementCollection 'TagName("as")
Dim RowText As String
Dim TimeFrame As Integer
Dim TimeFrame2 As String
Dim URL As String

TimeFrame2 = 1

URL = "https://forecast.weather.gov/MapClick.php?w0=t&w3=sfcwind&w3u=1&w4=sky&w5=pop&w6=rh&w7=rain&AheadHour=0&Submit=Submit&FcstType=digital&textField1=33.6414&textField2=-116.2591&site=all&unit=0&dd=&bw="

ie.Visible = True
ie.navigate URL

Do While ie.readyState <> READYSTATE_COMPLETE
Loop

Set htmlDoc = ie.document
TimeFrame = Worksheets("Selector").Range("B1").Value
TimeFrame2 = CStr(TimeFrame)

'htmlDoc.querySelector("[name=AheadHour] option[value='8']").Selected = True

htmlDoc.querySelector("[name=AheadHour] option[value='" & TimeFrame2 & "'").Selected = True

Application.Wait (Now + TimeValue("0:00:1"))
htmlDoc.getElementById("submit").Click
Application.Wait (Now + TimeValue("0:00:2"))

Worksheets("sheet1").Activate
ActiveSheet.Cells.NumberFormat = "General"


Set HTMLTables = htmlDoc.getElementsByTagName("table")
'Set HTMLTables = HTMLDoc.getElementsByTagName("tbody").Item("3")
For Each HTMLTable In HTMLTables
    'Debug.Print HTMLTable.Id, HTMLTable.className; vbCr
   
        For Each TableSection In HTMLTable.Children
            'Debug.Print , TableSection.tagName
                
                'For Each TableRow In TableRow.tagName("tr")
                
                For Each TableRow In TableSection.Children
                    RowText = ""
                    'For Each TableCell In TableCell.tagName("td")
                    
                    For Each TableCell In TableRow.Children
                    
                    ColCount = ColCount + 1: Cells(RowCount + 1, ColCount).NumberFormat = "@": Cells(RowCount + 1, ColCount) = RowText & vbTab & TableCell.innerText
                        'RowText = RowText & vbTab & TableCell.innerText
                    Next TableCell
                     ColCount = 0
                     RowCount = RowCount + 1
                    
                    Debug.Print , , RowText
                Next TableRow
        Next TableSection
Next HTMLTable

 
End Sub

【问题讨论】:

  • 提供测试值和预期输出很有用。您显示的代码适用于您应该更新的所有表,以显示重现问题的确切示例。

标签: html excel vba web web-scraping


【解决方案1】:

您显示的代码适用于所有表格。尝试使用以下两个专门针对表的伪类选择器之一:

ie.document.querySelector("body > table:nth-child(6)") 

或将 css 更改为

body > table:nth-of-type(6)

【讨论】:

    猜你喜欢
    • 1970-01-01
    • 1970-01-01
    • 2016-11-05
    • 1970-01-01
    • 1970-01-01
    • 1970-01-01
    • 1970-01-01
    • 2017-05-10
    • 1970-01-01
    相关资源
    最近更新 更多