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