使用USPS Macro -access DOM Explorer验证地址

时间:2018-08-28 18:36:56

标签: excel-vba usps

我正在使用以下代码通过USPS网站验证excel中的地址。我如何从DOM Explorer部分检索返回的数据?请参阅所附图片。

enter image description here

我能够在IE中看到来自USPS的数据返回,但是我无法在代码中检索到数据。谢谢您的帮助

我的代码

Sub useClassnames()
    Dim element As IHTMLElement
    Dim elements As IHTMLElementCollection
    Dim ie As InternetExplorer
    Dim html As HTMLDocument

    Sheets("Address").Select
    erow = Sheet3.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row

    'open Internet Explorer in memory, and go to website

    Set ie = New InternetExplorer
    ie.Visible = True

    ' Verify  addresses
    For r = 2 To 4
        myaddress = Cells(r, 1).Value
        mycity = Cells(r, 3).Value
        mystate = Cells(r, 4).Value
        myzipcode = Cells(r, 5).Value
        'myaddress = Range("a2").Value
        'mycity = Range("c2").Value
        'mystate = Range("d2").Value
        'myzipcode = Range("e2").Value

        'ie.navigate "https://tools.usps.com/go/ZipLookupAction!input.action"
        ie.navigate "https://tools.usps.com/zip-code-lookup.htm?byaddress"

        'Wait until IE has loaded the web page
        Do While ie.readyState <> READYSTATE_COMPLETE
            Application.StatusBar = "Loading Web page …"
            DoEvents
        Loop

        Set html = ie.document

        Set what = html.getElementsByName("tAddress")
        what.Item(0).Value = myaddress
        Set zipcode = html.getElementsByName("tCity")
        zipcode.Item(0).Value = mycity
        Set zipcode1 = html.getElementsByName("tState")
        zipcode1.Item(0).Value = mystate

        'Click the search button
        html.getElementById("zip-by-address").Click

        Do While ie.readyState <> READYSTATE_COMPLETE
            Application.StatusBar = "Loading Web page …"
            DoEvents
        Loop

        Set html = ie.document

        Set elements = html.getElementsByClassName("zipcode-result-address")

        For Each element In elements
            If element Like "*results*" Then
                MsgBox element
            End If
        Next element
        'End
    Next r
Set objie = Nothing
Set ele = Nothing
Set ie = Nothing
End Sub

1 个答案:

答案 0 :(得分:0)

我同意Comintern,因为使用他们的API会更清洁,但是为了向您展示您的距离,请参阅下文。

我相信以下代码将实现您所期望的,一个具有完整地址(包括邮政编码)的MessageBox:

Sub useClassnames()
Dim element As IHTMLElement
Dim elements As IHTMLElementCollection
Dim ie As InternetExplorer
Dim html As HTMLDocument
Dim ws As Worksheet: Set ws = Sheets("Address")
'declare and set the worksheet you are working with, amend as required

'Sheets("Address").Select
erow = ws.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row

'open Internet Explorer in memory, and go to website

Set ie = New InternetExplorer
ie.Visible = True

' Verify  addresses
    For r = 2 To 4
        myaddress = ws.Cells(r, 1).Value
        mycity = ws.Cells(r, 3).Value
        mystate = ws.Cells(r, 4).Value
        myzipcode = ws.Cells(r, 5).Value
        ie.navigate "https://tools.usps.com/zip-code-lookup.htm?byaddress"

        'Wait until IE has loaded the web page

        Do While ie.readyState <> READYSTATE_COMPLETE
            Application.StatusBar = "Loading Web page …"
            DoEvents
        Loop

        Set html = ie.document

        Set what = html.getElementsByName("tAddress")
        what.Item(0).Value = myaddress
        Set zipcode = html.getElementsByName("tCity")
        zipcode.Item(0).Value = mycity
        Set zipcode1 = html.getElementsByName("tState")
        zipcode1.Item(0).Value = mystate

        'Click the search button
        html.getElementById("zip-by-address").Click

        Do While ie.readyState <> READYSTATE_COMPLETE
            Application.StatusBar = "Loading Web page …"
            DoEvents
        Loop

        Set html = ie.document

        Set elements = html.getElementsByClassName("zipcode-result-address")

        For Each element In elements
            MsgBox element.innerText
        Next element
    Next r
Set objie = Nothing
Set ele = Nothing
Set ie = Nothing
End Sub