URL checking that Hyperlink.SubAddress loads (VBA)

[Deutz]

Hi All,

I have spent some time looking for code that will check a list of URLs and return 'OK' if they load successfully and 'FAILED' if not. The code below does that but there does not seem to be a way to test the Hyperlink.SubAddress (the position to go to on the web page) which some URLs have, as in the example below: #Usethecalc The code simply ignores the SubAddress, no matter what it is (all characters to the right of a hash symbol) and just checks the Hyperlink.Address itself.

Sub TestURLs()
    Dim strURL As String
    Dim oURL As Object
    Dim blnTest As Boolean
  
    strURL = "https://www.ato.gov.au/calculators-and-tools/simple-tax-calculator/?=top_10_calculators#Usethecalc"
    Set oURL = CreateObject("MSXML2.XMLHTTP")

    With oURL
        .Open "HEAD", strURL, False
        .Send
        blnTest = .Status = 200
        If blnTest = False Then
            Debug.Print strURL & " FAILED"
        Else
            Debug.Print strURL & " OK"
        End If
        Set oURL = Nothing
    End With
End Sub

Thanks kindly
Deutz

 

[John_w]

Hi John,

Hope you are well.

I would like to request your help please. I have been using this URL checking code that you assisted me with and it has been operating really well up until recently with some links failing the test. A few anchors are not being found in the web pages by the code, don't know if that is due to the website being redeveloped recently. The fragments that fail, all begin with #ato-

Have been mucking about with the code for a while, but to no avail.

Here are a couple that fail despite the URL fragment existing as a HTML page anchor ...

CGT small business entity eligibility | Australian Taxation Office

Work out your aggregated turnover to see if you're a small business entity for the small business CGT concessions.

www.ato.gov.au

What to include in your business's assessable income | Australian Taxation Office

What to include in your assessable income from carrying on your business.

www.ato.gov.au

Thanks in advance John

I've investigated your two new links.

I didn't know about this part in bold describing the fragment component of the URL (e.g. #ato-Calculateyouraggregatedturnover):

"An optional fragment component preceded by a hash (#). The fragment contains a fragment identifier providing direction to a secondary resource, such as a section heading in an article identified by the remainder of the URI. When the primary resource is an HTML document, the fragment is often an id attribute of a specific element, and web browsers will scroll this element into view." - from Uniform Resource Identifier - Wikipedia.

Therefore the code needs to loop through all elements looking for an element whose id attribute is "ato-Calculateyouraggregatedturnover". This id is found in the H2 element of the following HTML:

<h2 id="ato-Calculateyouraggregatedturnover">
  <a id="Calculateyouraggregatedturnover" class="anchor"></a>
  Calculate your aggregated turnover
</h2>

Updated code which now searches for the URL fragment in the element id attributes.

Public Sub Test_URLs3()

    Dim URL As String
 
    URL = "https://www.ato.gov.au/businesses-and-organisations/income-deductions-and-concessions/income-and-deductions-for-business/concessions-offsets-and-rebates/small-business-cgt-concessions/small-business-cgt-concessions-eligibility-conditions/cgt-small-business-entity-eligibility#ato-Calculateyouraggregatedturnover"
    Debug.Print URL & vbCrLf & Check_URL(URL)
 
    URL = "https://www.ato.gov.au/businesses-and-organisations/income-deductions-and-concessions/income-and-deductions-for-business/assessable-income/what-income-to-include#ato-Cryptoassets"
    Debug.Print URL & vbCrLf & Check_URL(URL)
 
End Sub



Public Function Check_URL(ByVal URL As String) As Boolean

    Dim oURL As Object
    Dim HTMLdoc As HTMLDocument
    Dim thisAnchor As HTMLAnchorElement
    Dim p As Long, anchor As String, anchorHTML As String
    Dim i As Long
 
    p = InStrRev(URL, "/")
    p = InStr(p, URL, "#")
    If p > 0 Then
        anchor = Mid(URL, p + 1)
        URL = Left(URL, p - 1)
    Else
        anchor = ""
    End If
   
    Set oURL = CreateObject("MSXML2.XMLHTTP")

    With oURL
 
        If anchor = "" Then
     
            .Open "HEAD", URL, False
            .send
            Check_URL = (.Status = 200)
     
        Else
         
            .Open "GET", URL, False
            .send
            'Debug.Print .responseText
            Set HTMLdoc = New HTMLDocument
            HTMLdoc.body.innerHTML = .responseText
                     
            'See if anchor exists by reading anchors collection directly by item name
         
            anchorHTML = ""
            On Error Resume Next
            anchorHTML = HTMLdoc.anchors(anchor).outerHTML
            On Error GoTo 0
         
            'If not found, see if anchor exists by looping through anchors collection
         
            i = 0
            While i < HTMLdoc.anchors.Length And anchorHTML = ""
                If StrComp(anchor, HTMLdoc.anchors(i).Name, vbTextCompare) = 0 Or StrComp(anchor, HTMLdoc.anchors(i).ID, vbTextCompare) = 0 Then
                    anchorHTML = HTMLdoc.anchors(i).outerHTML
                End If
                i = i + 1
            Wend
         
            'If not found, see if anchor exists as an element's id attribute
         
            i = 0
            While i < HTMLdoc.all.Length And anchorHTML = ""
                If StrComp(anchor, HTMLdoc.all(i).getAttribute("id"), vbTextCompare) = 0 Then
                    anchorHTML = HTMLdoc.all(i).outerHTML
                End If
                i = i + 1
            Wend
         
            'Debug.Print anchorHTML
            Check_URL = (anchorHTML <> "")
         
        End If
     
    End With
 
    Set oURL = Nothing
 
End Function

 

[Deutz]

Hi John,

Hope you are well.

I would like to request your help please. I have been using this URL checking code that you assisted me with and it has been operating really well up until recently with some links failing the test. A few anchors are not being found in the web pages by the code, don't know if that is due to the website being redeveloped recently. The fragments that fail, all begin with #ato-

Have been mucking about with the code for a while, but to no avail.

Here are a couple that fail despite the URL fragment existing as a HTML page anchor ...

CGT small business entity eligibility | Australian Taxation Office

Work out your aggregated turnover to see if you're a small business entity for the small business CGT concessions.

www.ato.gov.au

What to include in your business's assessable income | Australian Taxation Office

What to include in your assessable income from carrying on your business.

www.ato.gov.au

Thanks in advance John

Thanks so much John; I really appreciate your prompt, professional responses. As always, you are spot on and this has resolved my issues.

I did see some other posts about anchors being unable to be identified if they are inside frames/iframes and Javascript and was hoping that would not be the case. So I am glad it was a relatively simple solution for you to come up with.

Thanks kindly
Deutz

 

[John_w]

I was pleased to help. Just realised the new loop which searches for element ids:

            i = 0
            While i < HTMLdoc.all.Length And anchorHTML = ""
                If StrComp(anchor, HTMLdoc.all(i).getAttribute("id"), vbTextCompare) = 0 Then
                    anchorHTML = HTMLdoc.all(i).outerHTML
                End If
                i = i + 1
            Wend

can be replaced by this direct check which will be faster:

            If anchorHTML = "" Then
                On Error Resume Next
                anchorHTML = HTMLdoc.getElementById(anchor).outerHTML
                On Error GoTo 0
            End If

 

[Deutz]

I was pleased to help. Just realised the new loop which searches for element ids:

            i = 0
            While i < HTMLdoc.all.Length And anchorHTML = ""
                If StrComp(anchor, HTMLdoc.all(i).getAttribute("id"), vbTextCompare) = 0 Then
                    anchorHTML = HTMLdoc.all(i).outerHTML
                End If
                i = i + 1
            Wend

can be replaced by this direct check which will be faster:

            If anchorHTML = "" Then
                On Error Resume Next
                anchorHTML = HTMLdoc.getElementById(anchor).outerHTML
                On Error GoTo 0
            End If

Thanks for the optimisation, John.

Cheers
Deutz