vba - 未设置对象变量或 With Block 变量 - Access 2010 VBA

Question

向知识之井问好...

我一直在阅读关于这个特定错误的大量帖子，但没有找到任何解决我的特定问题的方法。

我在 Access 2010 前端中有一些 VBA 代码。有时，但并非总是如此，我会收到“未设置对象变量或 With block 变量”。错误。我的代码如下:

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

错误发生在两个特定的地方:

在“情况 1”下:错误发生在...之后立即

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

...被执行。我对此进行了调试并验证了该语句是否正确执行以及“PassedCongressionalDistrict”对象的值是否正确。

然后，在“Case Else”下:For 循环正确处理第一项列表，但在开始处理第二项时失败并出现识别错误，即使第二项中有良好且合法的数据也是如此。

我希望我已经解释得足够清楚了。我似乎无法弄清楚 (1) 如何更全面地调试它以及 (2) 为什么会出现错误，因为我似乎已经正确定义了所有对象变量。

问候， 肯

Answer 1

几乎肯定是，因为(有时)XML 主体中没有名为“元数据”的子节点成员 - 所以当您尝试将“元数据”对象绑定(bind)到 .selectSingleNode()方法它不返回任何内容。您始终可以检查以确保它确实已绑定(bind)...

    '// ...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...