mardi 20 avril 2021

How to edit this Get Request VBA code so it does not skip line codes?

So this VBA code that webs scrapes a work website using the Get Request method skips all the lines after “For Each Div in Divs” and goes straight to end sub. Nothing is pasted on the sheet. This code I edited from using Internet Explorer and this code worked fine with that method but it was slow. Any ideas? Here is the code. Thanks in advance!

Dim Table As IHTMLElement
Dim Tables As IHTMLElementCollection
Dim Div As IHTMLElement
Dim Divs As IHTMLElementCollection
Dim H3 As IHTMLElement
Dim TR As IHTMLElement
Dim TRs  As IHTMLElementCollection
Dim TD As IHTMLElement
Dim TDs  As IHTMLElementCollection
Dim Row As Integer
Dim Column As Integer

Dim ws As Worksheet





    
Set ws = ThisWorkbook.Worksheets("Setup")
           

       
Row = 1
Column = 1
 Set ws = Sheets("PROCESS")
 ws.Cells.Clear



Dim H As Object, doc As New HTMLDocument
Set H = CreateObject("WinHTTP.WinHTTPRequest.5.1")

URL = "WORK URL”

Debug.Print URL

ReTry:

H.SetAutoLogonPolicy 0
H.setTimeouts 0, 0, 0, 0
H.Open "GET", URL, True
H.send
H.waitForResponse



    If H.Status <> 200 Then
MsgBox H.Status & " - " & H.statusText
Exit Sub
End If

Debug.Print URL

doc.body.innerHTML = H.responseText


Set Divs =     doc.getElementById("secondaryProductivityList").getElementsByTagName("div")

For Each Div In Divs
    Set H3 = Div.getElementsByTagName("h3")(0)
   
    If Not Div.className = "floatHeader" And Not H3 Is Nothing Then
        ws.Cells(Row, 1).Value = H3.innerText
        Row = Row + 1
       
        Set Tables = Div.getElementsByTagName("table")
        Set Table = Tables(0)
        Set TRs = Table.getElementsByTagName("tr")
        For Each TR In TRs
            Column = 1
            Set TDs = TR.getElementsByTagName("th")
            For Each TD In TDs
                ws.Cells(Row, Column).Value = TD.innerText
                ws.Cells(Row, Column).Font.Bold = True
                If TD.getAttribute("colspan") Then
                    Column = Column + TD.getAttribute("colspan")
                Else
                    Column = Column + 1
                End If
                Next
                
            Set TDs = TR.getElementsByTagName("td")
            For Each TD In TDs
                ws.Cells(Row, Column).Value = TD.innerText
                Column = Column + 1
                Next
           
        Row = Row + 1
        Next
    End If
Row = Row + 1
Next


End Sub 



Aucun commentaire:

Enregistrer un commentaire