vbams-access-2010smartystreets

Object variable or With Block variable not set - Access 2010 VBA


Greetings to the well of knowledge...

I've been reading the numerous posts on this particular error and have not found anything that resolves my particular issue.

I have some VBA code within an Access 2010 front-end. Sometimes, but not always, I get a "Object variable or With block variable not set." error. My code is as follows:

Public Sub ValidateAddress(PassedAddress As Object, PassedCity As Object, PassedState As Object, _
    PassedZIP As Object, PassedCongressionalDistrict As Object, PassedValidated As Object, HomeForm As Form)

On Error GoTo ShowMeError
    Dim strUrl As String    ' Our URL which will include the authentication info
    Dim strReq As String    ' The body of the POST request
    Dim xmlHttp As New MSXML2.XMLHTTP60
    Dim xmlDoc As MSXML2.DOMDocument60
    Dim dbs As Database
    Dim candidates As MSXML2.IXMLDOMNode, candidate As MSXML2.IXMLDOMNode
    Dim components As MSXML2.IXMLDOMNode, metadata As MSXML2.IXMLDOMNode, analysis As MSXML2.IXMLDOMNode
    Dim AddressToCheck As Variant, CityToCheck As Variant, StateToCheck As Variant, ZIPToCheck As Variant
    Dim Validated As Boolean, District As Variant, MatchCode As Variant, Footnotes As Variant
    Dim candidate_count As Long, SQLCommand As String, Start, Finish

    ' This URL will execute the search request and return the resulting matches to the search in XML.
    strUrl = "https://api.smartystreets.com/street-address/?auth-id=<my_auth_id>" & _
    "&auth-token=<my_auth_token>"

    AddressToCheck = PassedAddress.Value
    CityToCheck = PassedCity.Value
    StateToCheck = PassedState.Value
    If Len(PassedZIP) = 6 Then ZIPToCheck = Left(PassedZIP.Value, 5) Else ZIPToCheck = PassedZIP.Value

    ' Body of the POST request
    strReq = "<?xml version=""1.0"" encoding=""utf-8""?>" & "<request>" & "<address>" & _
                "   <street>" & AddressToCheck & "</street>" & "   <city>" & CityToCheck & "</city>" & _
                "   <state>" & StateToCheck & "</state>" & "   <zipcode>" & ZIPToCheck & "</zipcode>" & _
                "   <candidates>5</candidates>" & "</address>" & "</request>"
    With xmlHttp
        .Open "POST", strUrl, False                     ' Prepare POST request
        .setRequestHeader "Content-Type", "text/xml"    ' Sending XML ...
        .setRequestHeader "Accept", "text/xml"          ' ... expect XML in return.
        .send strReq                                    ' Send request body
    End With

    ' The request has been saved into xmlHttp.responseText and is
    ' now ready to be parsed. Remember that fields in our XML response may
    ' change or be added to later, so make sure your method of parsing accepts that.
    ' Google and Stack Overflow are replete with helpful examples.

    Set xmlDoc = New MSXML2.DOMDocument60
    If Not xmlDoc.loadXML(xmlHttp.ResponseText) Then
        Err.Raise xmlDoc.parseError.errorCode, , xmlDoc.parseError.reason
        Exit Sub
    End If

    ' According to the schema (http://smartystreets.com/kb/liveaddress-api/parsing-the-response#xml),
    ' <candidates> is a top-level node with each <candidate> below it. Let's obtain each one.
    Set candidates = xmlDoc.documentElement

    ' First, get a count of all the search results.
    candidate_count = 0
    For Each candidate In candidates.childNodes
        candidate_count = candidate_count + 1
    Next

    Set candidates = xmlDoc.documentElement
    Select Case candidate_count
        Case 0 ' Bad address cannot be corrected.  Try again.
            Form_frmPeople.SetFocus
            MsgBox "The address supplied does not match a valid address in the USPS database.  Please correct this.", _
                vbOKOnly, "Warning"
            PassedAddress.BackColor = RGB(255, 0, 0)
            PassedCity.BackColor = RGB(255, 0, 0)
            PassedState.BackColor = RGB(255, 0, 0)
            PassedZIP.BackColor = RGB(255, 0, 0)
            Exit Sub
        Case 1 ' Only one candidate address...use it and return.
            For Each candidate In candidates.childNodes
                Set analysis = candidate.selectSingleNode("analysis")
                PassedAddress.Value = candidate.selectSingleNode("delivery_line_1").nodeTypedValue
                Set components = candidate.selectSingleNode("components")
                PassedCity.Value = components.selectSingleNode("city_name").nodeTypedValue
                PassedState.Value = components.selectSingleNode("state_abbreviation").nodeTypedValue
                PassedZIP.Value = components.selectSingleNode("zipcode").nodeTypedValue & "-" & _
                    components.selectSingleNode("plus4_code").nodeTypedValue
                Set metadata = candidate.selectSingleNode("metadata")
                PassedCongressionalDistrict.Value = CInt(metadata.selectSingleNode("congressional_district").nodeTypedValue)
                PassedValidated.Value = True
            Next
            Exit Sub
        Case Else ' Multiple candidate addresses...post them and allow the user to select.
            DoCmd.SetWarnings False
            Set dbs = CurrentDb
            If IsTableQuery("temptbl") Then dbs.Execute "DROP TABLE temptbl"

            dbs.Execute "CREATE TABLE temptbl (Selected BIT, CandidateAddress CHAR(50), CandidateCity CHAR(25), _
        CandidateState CHAR(2), CandidateZIP CHAR(10), CandidateCongressionalDistrict INTEGER, _
        MatchCode CHAR(1), Footnotes CHAR(30));"
            DoCmd.SetWarnings True

            Start = Timer
            Do While Timer < Start + 1
                DoEvents
            Loop

            For Each candidate In candidates.childNodes
                Set components = candidate.selectSingleNode("components")
                AddressToCheck = candidate.selectSingleNode("delivery_line_1").nodeTypedValue
                CityToCheck = components.selectSingleNode("city_name").nodeTypedValue
                StateToCheck = components.selectSingleNode("state_abbreviation").nodeTypedValue
                ZIPToCheck = components.selectSingleNode("zipcode").nodeTypedValue & "-" & _
                    components.selectSingleNode("plus4_code").nodeTypedValue
                Set metadata = candidate.selectSingleNode("metadata")
                District = metadata.selectSingleNode("congressional_district").nodeTypedValue
                Set analysis = candidate.selectSingleNode("analysis")
                MatchCode = analysis.selectSingleNode("dpv_match_code").nodeTypedValue
                Footnotes = analysis.selectSingleNode("dpv_footnotes").nodeTypedValue
                DoCmd.SetWarnings False
                dbs.Execute "INSERT INTO temptbl ( CandidateAddress, CandidateCity, CandidateState, CandidateZIP, _
                CandidateCongressionalDistrict, MatchCode, Footnotes ) " & vbCrLf & "SELECT """ & AddressToCheck & _
                    """ AS Expr1, """ & CityToCheck & """ AS Expr2, """ & StateToCheck & """ AS Expr3, """ & _
                    ZIPToCheck & """ AS Expr4, " & District & " AS Expr5, """ & MatchCode & """ AS Expr6, """ & _
                    Footnotes & """ AS Expr7;"
                DoCmd.SetWarnings True
            Next

            DoCmd.OpenForm "frmPeopleAddressMaintenance"

            Do Until CurrentProject.AllForms("frmPeopleAddressMaintenance").IsLoaded = False
                DoEvents
            Loop

            HomeForm.SetFocus
            If IsTableQuery("temptbl") Then dbs.Execute "DROP TABLE temptbl"
    End Select
    dbs.Close
    Exit Sub

ShowMeError:
    MsgBox Err.Description, vbOKOnly, "ERROR!"
End Sub

The error occurs in two specific places:

Under the "Case 1": The error happens immediately after...

PassedCongressionalDistrict.Value = CInt(metadata.selectSingleNode("congressional_district").nodeTypedValue)

...is executed. I have debugged this and verified that the statement executed properly and that the value of the "PassedCongressionalDistrict" object is correct.

Then, under "Case Else": The For loop processes the first item list correctly, but fails with the identified error when beginning processing the second item, even though there is good and legitimate data in the second item.

I hope I've explained this well enough. I just can't seem to figure out (1) how to more fully debug this and (2) why the error occurs as it seems that I have all of my object variables defined properly.

Regards, Ken


Solution

  • It's almost definitely because (on occasion) there is no child node member named "metadata" in the XML body - so when you try to bind your "metadata" object to the .selectSingleNode() method it returns Nothing. You can always check to make sure that it's actually bound...

        '// ...start code snippet...
    
        Set metadata = candidate.selectSingleNode("metadata")
    
        If Not metadata is Nothing Then 
            PassedCongressionalDistrict.Value = CInt(metadata.selectSingleNode("congressional_district").nodeTypedValue)
        End If
    
        PassedValidated.Value = True
    
       '// ...end code snippet...