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]

You could load the web page into the HTML DOM and see if the anchor (the text after #) exists. This needs a reference to MS HTML Object Library - it won't work with late binding.

Sub TestURLs()
    Dim strURL As String
    Dim oURL As Object
    Dim blnTest As Boolean
    Dim HTMLdoc As HTMLDocument
    Dim p As Long, anchor As String, anchorHTML As String
    
    strURL = "https://www.ato.gov.au/calculators-and-tools/simple-tax-calculator/?=top_10_calculators#Usethecalc"
    
    p = InStrRev(strURL, "/")
    p = InStr(p, strURL, "#")
    If p > 0 Then
        anchor = Mid(strURL, p + 1)
    Else
        anchor = ""
    End If
      
    Set oURL = CreateObject("MSXML2.XMLHTTP")

    With oURL
        If anchor = "" Then
            .Open "HEAD", strURL, False
            .send
            blnTest = .Status = 200
        Else
            .Open "GET", strURL, False
            .send
            Set HTMLdoc = New HTMLDocument
            HTMLdoc.body.innerHTML = .responseText
            anchorHTML = ""
            On Error Resume Next
            anchorHTML = HTMLdoc.anchors(anchor).outerHTML
            On Error GoTo 0
            blnTest = (anchorHTML <> "")
        End If
        
        If blnTest = False Then
            Debug.Print strURL & " FAILED"
        Else
            Debug.Print strURL & " OK"
        End If
        Set oURL = Nothing
    End With
End Sub

 

[Deutz]

You could load the web page into the HTML DOM and see if the anchor (the text after #) exists. This needs a reference to MS HTML Object Library - it won't work with late binding.

Sub TestURLs()
    Dim strURL As String
    Dim oURL As Object
    Dim blnTest As Boolean
    Dim HTMLdoc As HTMLDocument
    Dim p As Long, anchor As String, anchorHTML As String
   
    strURL = "https://www.ato.gov.au/calculators-and-tools/simple-tax-calculator/?=top_10_calculators#Usethecalc"
   
    p = InStrRev(strURL, "/")
    p = InStr(p, strURL, "#")
    If p > 0 Then
        anchor = Mid(strURL, p + 1)
    Else
        anchor = ""
    End If
     
    Set oURL = CreateObject("MSXML2.XMLHTTP")

    With oURL
        If anchor = "" Then
            .Open "HEAD", strURL, False
            .send
            blnTest = .Status = 200
        Else
            .Open "GET", strURL, False
            .send
            Set HTMLdoc = New HTMLDocument
            HTMLdoc.body.innerHTML = .responseText
            anchorHTML = ""
            On Error Resume Next
            anchorHTML = HTMLdoc.anchors(anchor).outerHTML
            On Error GoTo 0
            blnTest = (anchorHTML <> "")
        End If
       
        If blnTest = False Then
            Debug.Print strURL & " FAILED"
        Else
            Debug.Print strURL & " OK"
        End If
        Set oURL = Nothing
    End With
End Sub

Thanks so much John ... this is exactly what I was looking for. Works as required. Much appreciated

 

[Deutz]

You could load the web page into the HTML DOM and see if the anchor (the text after #) exists. This needs a reference to MS HTML Object Library - it won't work with late binding.

Sub TestURLs()
    Dim strURL As String
    Dim oURL As Object
    Dim blnTest As Boolean
    Dim HTMLdoc As HTMLDocument
    Dim p As Long, anchor As String, anchorHTML As String
   
    strURL = "https://www.ato.gov.au/calculators-and-tools/simple-tax-calculator/?=top_10_calculators#Usethecalc"
   
    p = InStrRev(strURL, "/")
    p = InStr(p, strURL, "#")
    If p > 0 Then
        anchor = Mid(strURL, p + 1)
    Else
        anchor = ""
    End If
     
    Set oURL = CreateObject("MSXML2.XMLHTTP")

    With oURL
        If anchor = "" Then
            .Open "HEAD", strURL, False
            .send
            blnTest = .Status = 200
        Else
            .Open "GET", strURL, False
            .send
            Set HTMLdoc = New HTMLDocument
            HTMLdoc.body.innerHTML = .responseText
            anchorHTML = ""
            On Error Resume Next
            anchorHTML = HTMLdoc.anchors(anchor).outerHTML
            On Error GoTo 0
            blnTest = (anchorHTML <> "")
        End If
       
        If blnTest = False Then
            Debug.Print strURL & " FAILED"
        Else
            Debug.Print strURL & " OK"
        End If
        Set oURL = Nothing
    End With
End Sub

Hi John, I have implimented your code and it works in some instances but have come across a few URLs with fragments that are flagged as Failed when the page loads ok in the browser and moves to the location/anchor as expected. If I could please get you to take a look and advise.

Here are some that Failed unexpectedly:

Rental properties 2023

Use these instructions to help you complete the Application for refund of franking credits for individuals.

www.ato.gov.au

Found this in the source: <h5 class="notoc"><a id="Noncommercialrental" class="anchor"></a>Non-commercial rental</h5>

Rental properties 2023

Use these instructions to help you complete the Application for refund of franking credits for individuals.

www.ato.gov.au

Found this in the source: <h3><a id="Coownershipofrentalproperty" class="anchor"></a>Co-ownership of rental property</h3>

Rental properties 2023

Use these instructions to help you complete the Application for refund of franking credits for individuals.

www.ato.gov.au

Found this in the source: <h4 class="notoc">Expenses prior to property being genuinely available for rent</h4>

Here are some that passed as expected:

Rental expenses you claim over several years

You can generally claim a deduction over several years for borrowing expenses, asset decline in value and capital works.

www.ato.gov.au

Found this in the source: <h2><a id="Capitalallowances" class="anchor"></a>Capital allowances</h2>

Rental expenses you can claim now

You can claim a deduction in the income year you incur rental expenses that relate to the management and maintenance of the property.

www.ato.gov.au

Found this in the source: <h2><a id="Prepaidexpenses" class="anchor"></a>Pre-paid expenses</h2>

Thanks for you help
Michael D

 

[John_w]

I've found a solution. If you request the URL without the anchor part then the response contains the whole HTML, including the anchor tag.

For example, request

https://www.ato.gov.au/forms/Rental-properties-2023/?page=4

instead of

https://www.ato.gov.au/forms/Rental-properties-2023/?page=4#Noncommercialrental

I've changed the code to a function which removes the anchor part if the URL contains an anchor and returns True or False. This now returns the expected results.

Public Sub Test_URLs()

    Dim URL As String
    
    URL = "https://www.ato.gov.au/forms/Rental-properties-2023/?page=4#Noncommercialrental"
    Debug.Print URL & " " & Check_URL(URL)
    
    URL = "https://www.ato.gov.au/forms/Rental-properties-2023/?page=4#Typesofrentalexpenses1"
    Debug.Print URL & " " & Check_URL(URL)
    
    URL = "https://www.ato.gov.au/forms/Rental-properties-2023/?page=3#Co_ownership_of_rental_property"
    Debug.Print URL & " " & Check_URL(URL)
    
    URL = "https://www.ato.gov.au/forms/Rental-properties-2023/?page=4#Expenses_prior_to_property_being_genuinely_available_for_rent"
    Debug.Print URL & " " & Check_URL(URL)
    
    URL = "https://www.ato.gov.au/Individuals/Investments-and-assets/Residential-rental-properties/Rental-expenses-to-claim/Rental-expenses-you-claim-over-several-years/#Capitalallowances"
    Debug.Print URL & " " & Check_URL(URL)
    
    URL = "https://www.ato.gov.au/Individuals/Investments-and-assets/Residential-rental-properties/Rental-expenses-to-claim/Rental-expenses-you-can-claim-now/#Prepaidexpenses"
    Debug.Print URL & " " & Check_URL(URL)

    URL = "https://www.ato.gov.au/Individuals/Investments-and-assets/Residential-rental-properties/Rental-expenses-to-claim/Rental-expenses-you-can-claim-now/#AnchorDoesntExist"
    Debug.Print URL & " " & Check_URL(URL)

End Sub


Public Function Check_URL(ByVal URL As String) As Boolean

    Dim oURL As Object
    Dim HTMLdoc As HTMLDocument
    Dim p As Long, anchor As String, anchorHTML As String
    
    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
            Set HTMLdoc = New HTMLDocument
            HTMLdoc.body.innerHTML = .responseText
            anchorHTML = ""
            On Error Resume Next
            anchorHTML = HTMLdoc.anchors(anchor).outerHTML
            On Error GoTo 0
            Check_URL = (anchorHTML <> "")
        End If
    End With
    
    Set oURL = Nothing
    
End Function

 

[Deutz]

I've found a solution. If you request the URL without the anchor part then the response contains the whole HTML, including the anchor tag.

For example, request

https://www.ato.gov.au/forms/Rental-properties-2023/?page=4

instead of

https://www.ato.gov.au/forms/Rental-properties-2023/?page=4#Noncommercialrental

I've changed the code to a function which removes the anchor part if the URL contains an anchor and returns True or False. This now returns the expected results.

Public Sub Test_URLs()

    Dim URL As String
   
    URL = "https://www.ato.gov.au/forms/Rental-properties-2023/?page=4#Noncommercialrental"
    Debug.Print URL & " " & Check_URL(URL)
   
    URL = "https://www.ato.gov.au/forms/Rental-properties-2023/?page=4#Typesofrentalexpenses1"
    Debug.Print URL & " " & Check_URL(URL)
   
    URL = "https://www.ato.gov.au/forms/Rental-properties-2023/?page=3#Co_ownership_of_rental_property"
    Debug.Print URL & " " & Check_URL(URL)
   
    URL = "https://www.ato.gov.au/forms/Rental-properties-2023/?page=4#Expenses_prior_to_property_being_genuinely_available_for_rent"
    Debug.Print URL & " " & Check_URL(URL)
   
    URL = "https://www.ato.gov.au/Individuals/Investments-and-assets/Residential-rental-properties/Rental-expenses-to-claim/Rental-expenses-you-claim-over-several-years/#Capitalallowances"
    Debug.Print URL & " " & Check_URL(URL)
   
    URL = "https://www.ato.gov.au/Individuals/Investments-and-assets/Residential-rental-properties/Rental-expenses-to-claim/Rental-expenses-you-can-claim-now/#Prepaidexpenses"
    Debug.Print URL & " " & Check_URL(URL)

    URL = "https://www.ato.gov.au/Individuals/Investments-and-assets/Residential-rental-properties/Rental-expenses-to-claim/Rental-expenses-you-can-claim-now/#AnchorDoesntExist"
    Debug.Print URL & " " & Check_URL(URL)

End Sub


Public Function Check_URL(ByVal URL As String) As Boolean

    Dim oURL As Object
    Dim HTMLdoc As HTMLDocument
    Dim p As Long, anchor As String, anchorHTML As String
   
    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
            Set HTMLdoc = New HTMLDocument
            HTMLdoc.body.innerHTML = .responseText
            anchorHTML = ""
            On Error Resume Next
            anchorHTML = HTMLdoc.anchors(anchor).outerHTML
            On Error GoTo 0
            Check_URL = (anchorHTML <> "")
        End If
    End With
   
    Set oURL = Nothing
   
End Function

Hi John,

Thanks for your prompt reply. This works perfectly.

Very much appreciated

Cheers
Michael D

 

[Deutz]

I've found a solution. If you request the URL without the anchor part then the response contains the whole HTML, including the anchor tag.

For example, request

https://www.ato.gov.au/forms/Rental-properties-2023/?page=4

instead of

https://www.ato.gov.au/forms/Rental-properties-2023/?page=4#Noncommercialrental

I've changed the code to a function which removes the anchor part if the URL contains an anchor and returns True or False. This now returns the expected results.

Public Sub Test_URLs()

    Dim URL As String
   
    URL = "https://www.ato.gov.au/forms/Rental-properties-2023/?page=4#Noncommercialrental"
    Debug.Print URL & " " & Check_URL(URL)
   
    URL = "https://www.ato.gov.au/forms/Rental-properties-2023/?page=4#Typesofrentalexpenses1"
    Debug.Print URL & " " & Check_URL(URL)
   
    URL = "https://www.ato.gov.au/forms/Rental-properties-2023/?page=3#Co_ownership_of_rental_property"
    Debug.Print URL & " " & Check_URL(URL)
   
    URL = "https://www.ato.gov.au/forms/Rental-properties-2023/?page=4#Expenses_prior_to_property_being_genuinely_available_for_rent"
    Debug.Print URL & " " & Check_URL(URL)
   
    URL = "https://www.ato.gov.au/Individuals/Investments-and-assets/Residential-rental-properties/Rental-expenses-to-claim/Rental-expenses-you-claim-over-several-years/#Capitalallowances"
    Debug.Print URL & " " & Check_URL(URL)
   
    URL = "https://www.ato.gov.au/Individuals/Investments-and-assets/Residential-rental-properties/Rental-expenses-to-claim/Rental-expenses-you-can-claim-now/#Prepaidexpenses"
    Debug.Print URL & " " & Check_URL(URL)

    URL = "https://www.ato.gov.au/Individuals/Investments-and-assets/Residential-rental-properties/Rental-expenses-to-claim/Rental-expenses-you-can-claim-now/#AnchorDoesntExist"
    Debug.Print URL & " " & Check_URL(URL)

End Sub


Public Function Check_URL(ByVal URL As String) As Boolean

    Dim oURL As Object
    Dim HTMLdoc As HTMLDocument
    Dim p As Long, anchor As String, anchorHTML As String
   
    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
            Set HTMLdoc = New HTMLDocument
            HTMLdoc.body.innerHTML = .responseText
            anchorHTML = ""
            On Error Resume Next
            anchorHTML = HTMLdoc.anchors(anchor).outerHTML
            On Error GoTo 0
            Check_URL = (anchorHTML <> "")
        End If
    End With
   
    Set oURL = Nothing
   
End Function

Hi John,

Thanks again for all your help. I have run this for many links which check out exactly as expected. Sorry to bother you again with this but I have just two links remaining that are flagged as failing and yet I can see the anchor on the web page via view source.

Information for primary producers 2023

Work out if you can claim deductions as a primary producer when completing your tax return 2023.

www.ato.gov.au

<h2><a id="Worksheet" class="anchor"></a>Worksheet</h2>

Guide to depreciating assets 2023

A guide to claiming the decline in value of capital assets used in gaining assessable income, such as a car or machinery.

www.ato.gov.au

<h3><a id="Project_pools" class="anchor"></a>Project pools</h3>


John, are you able to recommend any resources that would help me to become more familiar with the workings of HTML DOC so I don't have to bother others with this?

Thanks once again
Michael D

 

[John_w]

Sorry to bother you again with this but I have just two links remaining that are flagged as failing and yet I can see the anchor on the web page via view source.

I don't know why those two anchors aren't found in the anchors collection when the item is accessed directly by its name - anchorHTML = HTMLdoc.anchors(anchor).outerHTML.

If the anchor isn't found by the direct check, this code loops through the anchors collection and checks whether the item's name or id matches the required anchor. It works for your two new URLs.

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
    
    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
            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
            
            If anchorHTML = "" Then
                For Each thisAnchor In HTMLdoc.anchors
                    If StrComp(anchor, thisAnchor.Name, vbTextCompare) = 0 Or StrComp(anchor, thisAnchor.ID, vbTextCompare) = 0 Then
                        anchorHTML = thisAnchor.outerHTML
                    End If
                Next
            End If
            
            Check_URL = (anchorHTML <> "")
        End If
    End With
    
    Set oURL = Nothing
    
End Function

John, are you able to recommend any resources that would help me to become more familiar with the workings of HTML DOC so I don't have to bother others with this?

Here are some references:

Document Object Model (DOM) - Web APIs | MDN

The Document Object Model (DOM) connects web pages to scripts or programming languages by representing the structure of a document—such as the HTML representing a web page—in memory. Usually it refers to JavaScript, even though modeling HTML, SVG, or XML documents as objects are not part of the...

developer.mozilla.org

The HTML DOM API - Web APIs | MDN

The HTML DOM API is made up of the interfaces that define the functionality of each of the elements in HTML, as well as any supporting types and interfaces they rely upon.

developer.mozilla.org

HTML reference - HTML: HyperText Markup Language | MDN

This HTML reference describes all elements and attributes of HTML, including global attributes that apply to all elements.

developer.mozilla.org

 

[Deutz]

I don't know why those two anchors aren't found in the anchors collection when the item is accessed directly by its name - anchorHTML = HTMLdoc.anchors(anchor).outerHTML.

If the anchor isn't found by the direct check, this code loops through the anchors collection and checks whether the item's name or id matches the required anchor. It works for your two new URLs.

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
   
    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
            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
           
            If anchorHTML = "" Then
                For Each thisAnchor In HTMLdoc.anchors
                    If StrComp(anchor, thisAnchor.Name, vbTextCompare) = 0 Or StrComp(anchor, thisAnchor.ID, vbTextCompare) = 0 Then
                        anchorHTML = thisAnchor.outerHTML
                    End If
                Next
            End If
           
            Check_URL = (anchorHTML <> "")
        End If
    End With
   
    Set oURL = Nothing
   
End Function

Here are some references:

Document Object Model (DOM) - Web APIs | MDN

The Document Object Model (DOM) connects web pages to scripts or programming languages by representing the structure of a document—such as the HTML representing a web page—in memory. Usually it refers to JavaScript, even though modeling HTML, SVG, or XML documents as objects are not part of the...

developer.mozilla.org

The HTML DOM API - Web APIs | MDN

The HTML DOM API is made up of the interfaces that define the functionality of each of the elements in HTML, as well as any supporting types and interfaces they rely upon.

developer.mozilla.org

HTML reference - HTML: HyperText Markup Language | MDN

This HTML reference describes all elements and attributes of HTML, including global attributes that apply to all elements.

developer.mozilla.org

Thanks again John. I did think to loop through the collection with an INSTR search of the anchor but was not sure exactly how to do that with the HTML objects.

Your prompt quality responses are much appreciated.

Kind regards
Michael D