【发布时间】：2015-09-03 16:00:42
【问题描述】：
我要去以下网站：
我正在尝试提取出现的第一个 zip+4 (94703-2636)。
Dim doc As HTMLDocument
Set doc = IE.document
On Error Resume Next
output = doc.getElementsByClassName("zip4")(0).innerText
'Sheet1.Range("E2").Value = output
MsgBox output
'IE.Quit
End Sub
这就是我尝试的方式，但是文本框或将数据添加到范围中都会给出空白答案。这不是完整的代码，但之前的一切似乎都可以正常工作。
有什么想法可以解决这个问题吗？非常感谢！
编辑：这是我的完整代码：
它所引用的单元格是具有完整地址的单元格。
Sub USPS()
Dim IE As Object
Set IE = CreateObject("InternetExplorer.Application")
IE.Visible = True
IE.Navigate "https://tools.usps.com/go/ZipLookupAction!input.action?mode=1&refresh=true"
Do
DoEvents
Loop Until IE.READYSTATE = 4
Dim Address As String
Address = Sheet1.Range("A2").Value
Dim City As String
City = Sheet1.Range("B2").Value
Dim State As String
State = Sheet1.Range("C2").Value
Dim Zipcode As String
Zipcode = Sheet1.Range("D2").Value
Call IE.document.getElementbyID("tAddress").SetAttribute("value", Address)
Call IE.document.getElementbyID("tCity").SetAttribute("value", City)
With IE.document.getElementbyID("sState")
For i = 0 To .Length - 1
If .Item(i).Value = State Then
.Item(i).Selected = True
Exit For
End If
Next
End With
Call IE.document.getElementbyID("Zzip").SetAttribute("value", Zipcode)
Set ElementCol = IE.document.getElementbyID("lookupZipFindBtn")
ElementCol.Click
''''' Hard Part
Dim doc As HTMLDocument
Set doc = IE.document
On Error Resume Next
output = Trim(doc.getElementsByClassName("zip4")(0).innerText)
'Sheet1.Range("E2").Value = output
MsgBox output
'IE.Quit
End Sub
编辑 2：带有动态 URL 的 XML？
Sub ZipLookUp()
Dim URL As String, xmlHTTP As Object, html As Object, htmlResponse As String
Dim SStr As String, EStr As String, EndS As Integer, StartS As Integer
Dim Zip4Digit As String
Dim number As String
Dim address As String
Dim city As String
Dim state As String
Dim zipcode As String
Dim abc As String
number = Sheet1.Range("A2")
address = Sheet1.Range("B2")
city = Sheet1.Range("C2")
state = Sheet1.Range("D2")
zipcode = Sheet1.Range("E2")
URL = "https://tools.usps.com/go/ZipLookupResultsAction!input.action?resultMode=1&companyName=&address1="
URL = URL & number & "+" & address & "&address2=&city=" & city & "&state=" & state & "&urbanCode=&postalCode=&zip=" & zipcode
Set xmlHTTP = CreateObject("MSXML2.XMLHTTP")
xmlHTTP.Open "GET", URL, False
On Error GoTo NoConnect
xmlHTTP.send
On Error GoTo 0
Set html = CreateObject("htmlfile")
htmlResponse = xmlHTTP.responseText
If htmlResponse = Null Then
MsgBox ("Aborted - HTML response was null")
GoTo End_Prog
End If
SStr = "<span class=""zip4"">": EStr = "</span><br />" 'Searches for a string within 2 strings
StartS = InStr(1, htmlResponse, SStr, vbTextCompare) + Len(SStr)
EndS = InStr(StartS, htmlResponse, EStr, vbTextCompare)
Zip4Digit = Left(Mid(htmlResponse, StartS, EndS - StartS), 4)
Sheet1.Range("F2").Value = Zip4Digit
GoTo End_Prog
NoConnect:
If Err = -2147467259 Or Err = -2146697211 Then MsgBox "Error - No Connection": GoTo End_Prog 'MsgBox Err & ": " & Error(Err)
End_Prog:
End Sub
【问题讨论】：
-
这在 IE 控制台中对我有用。可能有助于显示更多实际代码。
-
这是我的完整代码。如果它对你有用，会不会是与我之前的不兼容？