mercredi 24 juin 2020

VBA Grab only Main Table from HTML Web Scrape. not the whole page

I have made the work by using excel copy and paste, not by web scraping properly. I am interested in capturing ONLY the data from the main table, but instead, I an getting everything in my response. How do I get just the main table? I have tried to use ..." 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



Aucun commentaire:

Enregistrer un commentaire