Question

我正在处理以前已经解决过的问题，但在这种情况下不行。

我正在使用VBA从USPS网站提取地址。当我在单元格“ ele.innertext”中放置所有类的内文时，但是VBA不允许我将内文隔离到项目级别-ele.item（1）。例如，innertext给我上述错误。你知道为什么吗？

我的浏览器是IE11。

相关HTML：

<div id="zipByAddressDiv" class="industry-detail">Loading...</div>

                            <!-- start Handlebars template -->
                            <script id="zipByAddressTemplate" type="text/x-handlebars-template">
                                <ul class="list-group industry-detail">
                                {{#each addressList}}
                                    <li class="list-group-item paginate">
                                        <div class="zipcode-result-address">
                                            <p>{{companyName}}</p>
                                            <p>{{addressLine1}}</p>
                                            <p>{{city}} {{state}} <strong>{{zip5}}-{{zip4}}</strong></p>

VBA：

   Sub USPS()

Dim eRow As Long
Dim ele As Object
Dim objie As Object
Dim wscript As Object
Dim test As String
Dim testarray() As String
'Dim goods As Object
Dim r As Integer
Dim x As Long: x = 0
Dim vFacility As Variant
Dim y As Variant
'Dim IE As New InternetExplorer
Sheets("Address").Select

eRow = Sheet1.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
Set objie = CreateObject("InternetExplorer.Application")

For r = 4 To 8

myaddress = Cells(r, 5).Value
mycity = Cells(r, 7).Value
mystate = Cells(r, 8).Value
myzipcode = Cells(r, 9).Value

'myaddress = Range("a2").Value
'mycity = Range("c2").Value
'mystate = Range("d2").Value
'myzipcode = Range("e2").Value


With objie
.Visible = True
.navigate "https://tools.usps.com/go/ZipLookupAction!input.action"

Do While .Busy
DoEvents
Loop



Set what = .document.getElementsByName("tAddress")
what.Item(0).Value = myaddress
Set zipcode = .document.getElementsByName("tCity")
zipcode.Item(0).Value = mycity
Set zipcode1 = .document.getElementsByName("tState")
zipcode1.Item(0).Value = mystate
Set zipcode2 = .document.getElementsByName("tZip-byaddress")
zipcode2.Item(0).Value = myzipcode

.document.getElementByID("zip-by-address").Click


Do While .Busy
DoEvents
Loop


 For Each ele In .document.all

Select Case ele.className
Case "industry-detail"
test = ele.innertext
testarray = Split(test, vbCrLf)

Worksheets("Address").Cells(r, 11).Value = testarray(4)

'Debug.Print test
'Debug.Print "and"
'Debug.Print testarray(4)

End Select

Next ele
End With



Next r
Set objie = Nothing
Set ele = Nothing
Set IE = Nothing

'IE.Quit


End Sub

Answer 1

我想您要尝试的是输入地址详细信息并检索找到的邮政编码。此方法使用CSS selectors来定位页面样式，我首先从地址搜索URL开始。我尽可能使用id选择器（这与说.document.getElementById("yourID")，用#表示相同，因为它们是最快的检索方法。在选择状态（即下拉菜单）时，我选择了适当的选择器）您可以将搜索状态2字母缩写并入选项字符串中，例如

Dim state As String 
state = "NY"
.querySelector("option[value=" & state &  "]").Selected = True

有一个循环可确保目标元素出现在新的搜索结果页面中。我使用#zipByAddressDiv strong的另一个CSS选择器来仅将结果中以粗体显示的邮政编码作为目标。粗体由strong标记设置。

strong标签中包含邮政编码：

CSS查询：

上面的CSS选择器是使用#zipByAddressDiv通过id来定位的，然后，它使用descendant selector来定位strong的标签，而不是将其拆分为一个数组以获取所需的值。包含所需值的元素。

VBA：

Option Explicit
Public Sub AddressSearch()
    Dim IE As New InternetExplorer, t As Date, ele As Object
    Const MAX_WAIT_SEC As Long = 5

    With IE
        .Visible = True
        .navigate "https://tools.usps.com/zip-code-lookup.htm?byaddress"

        While .Busy Or .readyState < 4: DoEvents: Wend

        With .document
            .querySelector("#tAddress").Value = "1 Main Street"
            .querySelector("#tCity").Value = "New York"
            .querySelector("option[value=NY]").Selected = True
            '  .querySelector("#tZip-byaddress").Value = 10045
            .querySelector("#zip-by-address").Click
        End With

        While .Busy Or .readyState < 4: DoEvents: Wend

        t = Timer
        Do
            DoEvents
            On Error Resume Next
            Set ele = .document.querySelector("#zipByAddressDiv strong")
            On Error GoTo 0
            If Timer - t > MAX_WAIT_SEC Then Exit Do
        Loop While ele Is Nothing

        Debug.Print ele.innerText
        .Quit
    End With
End Sub

这是循环中的样子：

Option Explicit
Public Sub AddressSearch()
    Dim IE As New InternetExplorer, t As Date, ele As Object, i As Long
    Dim ws As Worksheet: Set ws = ThisWorkbook.Worksheets("Address")
    Const MAX_WAIT_SEC As Long = 5

    With IE
        .Visible = True

        For i = 4 To 8

            .navigate "https://tools.usps.com/zip-code-lookup.htm?byaddress"

            While .Busy Or .readyState < 4: DoEvents: Wend

            With .document
                .querySelector("#tAddress").Value = ws.Cells(i, 5).Value
                .querySelector("#tCity").Value = ws.Cells(i, 7).Value
                .querySelector("option[value=" & ws.Cells(i, 8).Value & "]").Selected = True
                '  .querySelector("#tZip-byaddress").Value = 10045
                .querySelector("#zip-by-address").Click
            End With

            While .Busy Or .readyState < 4: DoEvents: Wend

            t = Timer
            Do
                DoEvents
                On Error Resume Next
                Set ele = .document.querySelector("#zipByAddressDiv strong")
                On Error GoTo 0
                If Timer - t > MAX_WAIT_SEC Then Exit Do
            Loop While ele Is Nothing

            ws.Cells(i, 11) = ele.innerText
            Set ele = Nothing
        Next
        .Quit
    End With
End Sub

运行时错误438对象不支持此属性或方法

1 个答案: