Pulling specific data from the web to excel

[Brad2018]

Hi guys,

I have been using a search function box to pull specific data from a website which up until a few weeks ago has stopped working because the website name has changed and the coding does not work anymore.

The website was called (.golflink.com.au) but is now called (.golf.org.au) from here we enter the golfers id number to find out what their current golf handicap. (Need to find their latest GA handicap, eg 20.1 it should be in orange with white numbers also located at the top of their rounds listed as #1 )

Can anyone help me update the coding within this sheet so when I look up a handicap it pulls the data I need?

here is the current code:

Option Explicit

Private HTMLdoc     As Object
Private oXMLHTTP    As Object

Sub Button1_Click()

    Call GetHandicaps
    
End Sub

Private Sub GetHandicaps()
    
    Const LABEL1            As String = "ctl11_lblExactHandicap"
    Const URL_GOLFLINK      As String = "http://www.golf.org.au/handicap-interstitial/"
    
    Dim Cell        As Range
    Dim HTMLdoc     As Object
    Dim Rng         As Range
    Dim Span        As Object
    Dim sPageHTML   As String
    Dim sURL        As String
    
            Set Rng = Range("C3:E3", Cells(Rows.Count, "C").End(xlUp))
            
            If oXMLHTTP Is Nothing Then Set oXMLHTTP = CreateObject("MSXML2.ServerXMLHTTP")
        
            For Each Cell In Rng.Columns(2).Cells
                ' // Allow Excel to do other taks while code is running.
                DoEvents
                
                ' // Webpage address for handicap.
                sURL = URL_GOLFLINK & Cell & "/Skip"

                ' // Retrieve the webpage source code.
                oXMLHTTP.Open "GET", sURL, False
                oXMLHTTP.send
            
                ' // Check for communication errors.
                If oXMLHTTP.Status = 200 Then
                    sPageHTML = oXMLHTTP.responseText
 
                    ' // Check if HTML document exists.
                    If HTMLdoc Is Nothing Then Set HTMLdoc = CreateObject("htmlfile")

                    ' // Convert the page source code into HTML elements.
                    HTMLdoc.Write sPageHTML
                    HTMLdoc.Close

                    Set Span = HTMLdoc.getelementByID(LABEL1)
                
                    If Span Is Nothing Then
                       ' // The element holding the handicap is missing from this webpage.
                        Cell.Offset(0, 1).Value = "Error: Handicap Not Found"
                    Else
                        ' // Display the handicap.
                        Cell.Offset(0, 1).Value = Span.innerText
                    End If
                Else
                    ' // Display an error message with the error number and description in place of the handicap.
                    Cell.Offset(0, 1).Value = "Error: " & oXMLHTTP.Status & " - " & oXMLHTTP.statusText
                End If
            Next Cell
        
End Sub

Thanks,
Brad

 

[Macropod]

The new website URL is https://www.golf.org.au/, not http://www.golf.org.au/

 

[Brad2018]

Thank you for finding the error but it has not resolved my issue.

The website has now added in that I need to login using a username and password in order to get the latest golflink numbers.

Is there anyway I can send you my excel sheet so you have have a look and see if you can get it working?

Thanks,
Brad2018

 

[Macropod]

In that case, do a search of other threads discussing that particular issue. For example: https://www.mrexcel.com/forum/excel-questions/461524-vba-open-website-logon-username-password.html