Our training courses

Other training resources

Our training venues

Why we are different

Details for mkayiran

mkayiran has participated in the following threads:

Added by mkayiran on 03 Jan 2020 at 00:59

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

Head office

Kingsmoor House

Railway Street

GLOSSOP

SK13 2AA

London

Landmark Offices

99 Bishopsgate

LONDON

EC2M 3XD

Manchester

Holiday Inn

25 Aytoun Street

MANCHESTER

M1 3AE

© Wise Owl Business Solutions Ltd 2024. All Rights Reserved.

End of small page here
Please be aware that our website uses cookies!
I'm OK with this Tell me more ...