ABN Lookup VBA Script

[Mitchellstokes]

Hey Guys,

I've been running a VBA script from Microsoft Access that looks up an ABN number from the ABN lookup website.

It appears that an upgrade to ie10 may have ruined the script. It fails at "Set contentmajor=ie.Document.getelementbyid("content-major")" with error: "Run-time error '-2147467259 (80004005)': Method 'Document' of object 'iWebBrowser2' failed.

Option Compare Database
Private Sub CheckABRButton_Click()
Dim ie As Object
Dim fromStart, toStart, readLength, contentMajorStart As Variant
Dim abnDetails As Object
Dim contentMajor As Object
Dim searchNumber, entityName, entityType, ACN, businessLocation, status As String
If Len(f_abrABNACN) > 0 Then
    searchNumber = Replace(f_abrABNACN, " ", "")
Else
    searchNumber = ""
End If
If Len(searchNumber) = 11 Or Len(searchNumber) = 9 Then
    
    Set ie = CreateObject("internetexplorer.application")
    
    ie.Visible = False
    ie.navigate "[url=http://abr.business.gov.au/SearchByAbn.aspx?SearchText]ABN Lookup -[/url]=" & searchNumber
    
    While ie.busy
        DoEvents
    Wend
    Set contentMajor = ie.Document.getelementbyid("content-major")
    'MsgBox contentMajor.innerHTML
    If contentMajor Is Nothing Then
        MsgBox "Request to ABR failed. There might be too much network traffic at this time. Please try again."
        ie.Quit
        Exit Sub
    Else
        contentMajorStart = InStr(contentMajor.innerhtml, "process-error")
    End If
    
    If contentMajorStart > 0 Then
        f_abrEntityName = ""
        f_abrEntityType = ""
        f_abrACN = ""
        f_abrPostCode = ""
        f_abrStatus = ""
        CopyDetailsButton.Visible = False
        MsgBox "The details you provided couldn't be found in the ABR. Please re-check them and try again."
    Else
        Set abnDetails = ie.Document.getelementbyid("abn-details")
        
        If abnDetails Is Nothing Then
            MsgBox "Request to ABR failed. There might be too much network traffic at this time."
            ie.Quit
            Exit Sub
        End If
        
        ' Get entityName - was 40 shift, depends on version of IE!
        fromStart = InStr(abnDetails.innerhtml, "Entity name:") + 23
        toStart = InStr(fromStart, abnDetails.innerhtml, "</td>")
        readLength = toStart - fromStart
        entityName = Trim(Mid(abnDetails.innerhtml, fromStart, readLength))
        f_abrEntityName = entityName
        
        ' Get entityType
        fromStart = InStr(abnDetails.innerhtml, "href=""/EntityTypeDescription.aspx?Id=")
        If fromStart <= 0 Then
            fromStart = InStr(abnDetails.innerhtml, "Entity Type:") + 43
            toStart = InStr(fromStart, abnDetails.innerhtml, "</td>")
        Else
            fromStart = fromStart + 44
            toStart = InStr(fromStart, abnDetails.innerhtml, "</a>")
        End If
        readLength = toStart - fromStart
        entityType = Trim(Mid(abnDetails.innerhtml, fromStart, readLength))
        f_abrEntityType = entityType
        
        ' Get ACN
        If entityType = "Australian Private Company" Then
            fromStart = InStr(abnDetails.innerhtml, "searchType=OrgAndBusNm") + 38
            ACN = Trim(Mid(abnDetails.innerhtml, fromStart, 9))
            f_abrACN.Visible = True
            f_abrACN = ACN
        Else
            f_abrACN = ""
            f_abrACN.Visible = False
        End If
        
        'Get Business Location - was 40 shift, depends on version of IE!
        fromStart = InStr(abnDetails.innerhtml, "location:") + 23
        toStart = InStr(fromStart, abnDetails.innerhtml, "</td>")
        readLength = toStart - fromStart
        businessLocation = Trim(Mid(abnDetails.innerhtml, fromStart, readLength))
        'f_abrPostCode = Split(businessLocation, " ")(1)
        f_abrPostCode = businessLocation
        
        'Get Status - was 35 shift, depends on version of IE!
        fromStart = InStr(abnDetails.innerhtml, "status:") + 18
        toStart = InStr(fromStart, abnDetails.innerhtml, "</td>")
        readLength = toStart - fromStart
        status = Trim(Mid(abnDetails.innerhtml, fromStart, readLength))
        f_abrStatus = Split(status, " ")(0)
        
        CopyDetailsButton.Visible = True
        
    End If
    
    ie.Quit
Else
    MsgBox "You need to enter a valid ABN or ACN to continue. ABNs are 11 digits, ACNs are 9 digits."
End If
End Sub

I've had a look online but I'm not that familiar with this type of code.

 

[ztodd]

What's an example ABN number to search for? I'm not sure what that "ie.navigate..." line is doing- is it doing a google search, or other type of internet search, or somehow going straight to the "ABN lookup website", whatever that is? Not sure how it would be doing that...

I just noticed you said this script was from microsoft acccess- but you posted in the Excel questions category- did you copy the code into a module in an excel workbook, or are you running it in access?

 

[Mitchellstokes]

For example, facebook's ABN is: 83 134 012 543

The ie.navigate line came through wrong in the code. It is actually this:

ie.navigate "http://abr.business.gov.au/SearchByAbn.aspx?SearchText=" & searchNumber

It goes straight to the ABN page of the ABN you enter.

I'm running through from Access, runs when I click a button (It is contained in a sub)

 

[ztodd]

For what it's worth, when I run it in an Excel VBA module using IE 11 (only copied the code up to the line you got the error), it seems to run just fine. Are you able to upgrade to IE 11?

 

[Mitchellstokes]

Unfortunately i'm carrying this operation out for my employer and as such, their programs are controlled by IT and they wont update IE until they do it for EVERYONE. Any work around? It used to work?

 

[Kyle123]

I'd do it like this and remove the reliance on IE

Public Function ABNData(ABNid As String) As Collection


    Dim request As Object
    Dim dom As Object
    Dim tr As Object
    Dim searchTerms, searchTerm
    Dim i As Long
    Dim data As New Collection
    
    Const url As String = "http://abr.business.gov.au/SearchByAbn.aspx?abn="
    
    
    searchTerms = Array("Entity name", "ABN status", "Entity type", "Goods & Services Tax (GST)", "Main business location")
    
    Set request = CreateObject("WinHttp.Winhttprequest.5.1")
    Set dom = CreateObject("htmlFile")
    
    On Error GoTo errhandler:
    
        With request
            .Open "GET", url & ABNid, False
            .send
            If request.Status = 200 Then
                If InStr(1, request.responsetext, "Problem searching ABN Lookup") = 0 Then
                    dom.write request.responsetext
                    For Each tr In dom.getelementsbytagname("table")(0).Rows
                        For Each searchTerm In searchTerms
                            If InStr(1, tr.Cells(0).innerText, searchTerm) > 0 Then
                                data.Add tr.Cells(1).innerText, searchTerm
                                Exit For
                            End If
                        Next searchTerm
                    Next tr
                Else
                    Err.Raise 11112, Description:="The ABN Number does not exist in the database"
                End If
            Else
                Err.Raise 11111, Description:="The website could not be reached or has errored"
            End If
        End With
    
    Set ABNData = data
    
    Exit Function
    
errhandler:
        MsgBox "Error # " & Err.Number & vbCrLf & Err.Description


End Function

 

[Mitchellstokes]

Kyle thanks so much for that code. I semi-understand how it works, however, I'm not sure how to incorporate it into my current Microsoft Access processes. Do I put that code into its own module, have a button click call the function and insert Forms![AddNewApplication].f_abrEntityName= EntityName ?