Read our blogs, tips and tutorials
Try our exercises or test your skills
Watch our tutorial videos or shorts
Take a self-paced course
Read our recent newsletters
License our courseware
Book expert consultancy
Buy our publications
Get help in using our site
546 attributed reviews in the last 3 years
Refreshingly small course sizes
Outstandingly good courseware
Whizzy online classrooms
Wise Owl trainers only (no freelancers)
Almost no cancellations
We have genuine integrity
We invoice after training
Review 30+ years of Wise Owl
View our top 100 clients
Search our website
We also send out useful tips in a monthly email newsletter ...
Hello Andrew Gould & WiseOwlTutorials
Thank you very much for bringing these videos together! It really helped me practice the sample I wanted to do! I was able to gather the information I wanted using I.E. However, when I tried to simulate my actions when using the MSXML2.ServerXMLhttp.6.0 method, VBA was unable to recognize the same ID and tag names recognized by I.E.
I present my VBA code at the bottom. Can you help with this?! Where's the error?
Thank you so much. Good work.
My VBA Code:
Option Explicit
Sub ListTableOptions()
Dim XMLPage As New MSXML2.XMLHTTP60
Dim HTMLDoc As New MSHTML.HTMLDocument
Dim TableOptionsLinks As MSHTML.IHTMLElementCollection
Dim TableOptions As MSHTML.IHTMLElement
Dim TableOptionLink As MSHTML.IHTMLElement
Dim TableName As String
Dim URL As String
Dim NextHref As String
Dim NextURL As String
Dim DisplayName As String
DeleteOldSheets
URL = "https://www.whoscored.com/Regions/108/Tournaments/5/Seasons/7928/Stages/17835/Show/Italy-Serie-A-2019-2020"
XMLPage.Open "GET", URL, False
XMLPage.send
If XMLPage.Status <> 200 Then
MsgBox "Problem" & vbNewLine & XMLPage.Status & " - " & XMLPage.statusText
Exit Sub
End If
HTMLDoc.body.innerHTML = XMLPage.responseText
Set XMLPage = Nothing
Set TableOptions = HTMLDoc.getElementById("tournament-tables-17835-options")
Set TableOptionsLinks = TableOptions.getElementsByTagName("a")
For Each TableOptionLink In TableOptionsLinks
If LCase(TableOptionLink.innerText) <> "progress" Then
TableName = Right(TableOptionLink.href, Len(TableOptionLink.href) - InStr(TableOptionLink.href, "#"))
NextHref = TableOptionLink.getAttribute("href")
NextURL = URL & Mid(NextHref, InStr(NextHref, ":") + 6)
XMLPage.Open "GET", NextURL, False
XMLPage.send
If XMLPage.Status <> 200 Then
MsgBox "Problem" & vbNewLine & XMLPage.Status & " - " & XMLPage.statusText
Exit Sub
End If
HTMLDoc.body.innerHTML = XMLPage.responseText
Set XMLPage = Nothing
ProcessTable HTMLDoc.getElementById(TableName & "-grid"), TableOptionLink.innerText, TableName
End If
Next TableOptionLink
End Sub
Sub ProcessTable(HTMLTable As MSHTML.IHTMLElement, DisplayName As String, TableName As String)
Dim HTMLTable1 As MSHTML.IHTMLElement
Dim TableSection As MSHTML.IHTMLElement
Dim TableRows As MSHTML.IHTMLElementCollection
Dim TableRow As MSHTML.IHTMLElement
Dim TableCell As MSHTML.IHTMLElement
Dim A1 As MSHTML.IHTMLElement
Dim A2 As MSHTML.IHTMLElement
Dim RowNum As Long, ColNum As Integer
Worksheets.Add
ActiveSheet.Name = DisplayName
Range("A1").Value = DisplayName
RowNum = 2
For Each TableSection In HTMLTable.Children
If LCase(TableSection.tagName) <> "tfoot" Then
If LCase(TableSection.tagName) = "thead" Then
Set TableRows = TableSection.getElementsByTagName(TableName & "-general-header")
ElseIf LCase(TableSection.tagName) = "tbody" Then
Set TableRows = TableSection.Children
End If
For Each TableRow In TableRows
ColNum = 1
For Each TableCell In TableRow.Children
Cells(RowNum, ColNum).Value = TableCell.innerText
ColNum = ColNum + 1
Next TableCell
RowNum = RowNum + 1
Next TableRow
End If
Next TableSection
Range("A1").CurrentRegion.EntireColumn.AutoFit
Range("A1:B1").Font.Size = 12
Range("A2", Range("A2").End(xlToRight)).Offset(-1, 0).Interior.Color = rgbDarkBlue
Range("A2", Range("A2").End(xlToRight)).Interior.Color = rgbCornflowerBlue
Range("A2", Range("A2").End(xlToRight).Offset(-1, 0)).Font.Color = rgbWhite
Range("A2", Range("A2").End(xlToRight).Offset(-1, 0)).Font.Bold = True
End Sub
Sub DeleteOldSheets()
Dim ws As Worksheet
Application.DisplayAlerts = False
For Each ws In ThisWorkbook.Worksheets
If Not ws Is Menu Then ws.Delete
Next ws
Application.DisplayAlerts = True
End Sub
Kingsmoor House
Railway Street
GLOSSOP
SK13 2AA
Landmark Offices
99 Bishopsgate
LONDON
EC2M 3XD
Holiday Inn
25 Aytoun Street
MANCHESTER
M1 3AE
© Wise Owl Business Solutions Ltd 2024. All Rights Reserved.