我希望这不是一个愚蠢的问题。现在好运，我有一个高低搜索的答案。我是新手，使用VBA从互联网上获取信息。我有一个使用IE.doc的工作版本，但它很慢，你必须等待浏览器加载。我在下面提供了一个工作函数，我转换成了一个例子。问题是，如果不打开父窗口，您将无法访问所有跟踪号码。
这是我用来通过Internet Explore调用父窗口的JavaScript。这甚至可能吗？我正朝着正确的方向前进吗？
IE.document.parentWindow.execScript“handleTrackDetailShowShipments（）”，“JavaScript”
这是我第一次使用“With CreateObject（”msxml2.xmlhttp“）”所以也许我只是在搜索答案时问错了。
参考：Microsoft VBScript正则表达式5.5
VBA：
Sub GetTrackingData_Html_UPS()
Dim TrackN As String
Dim x As Long, y As Long
Dim Htm As Object
Dim i As Integer
Dim theRegex As Object
Dim theString As String
Dim s() As String
Dim myColl As Collection
Dim iCtr As Long
Dim tempArray As Variant
Set myColl = New Collection
Set theRegex = CreateObject("VBScript.RegExp")
With theRegex
.MultiLine = False
.Global = True
.IgnoreCase = False
End With
Set Htm = CreateObject("htmlFile")
TrackN = "1Z7452780345800256"
With CreateObject("msxml2.xmlhttp")
.Open "GET", "http://wwwapps.ups.com/WebTracking/processRequest?HTMLVersion=" & _
"5.0&Requester=NES&AgreeToTermsAndConditions=yes&loc=en_US&tracknum=" _
& TrackN & "&WT.z_eCTAid=ct1_eml_Tracking", False
.send
Htm.body.innerHTML = .responseText
End With
'IE.document.parentWindow.execScript "handleTrackDetailShowShipments()", "JavaScript" '< I want data from the parent window
'/\ this works if i use InternetExplorer but it is so slow and hit or miss
Debug.Print Htm.getElementsByTagName("h1")(0).innerText & vbNewLine & _
Htm.getElementsByTagName("h4")(1).innerText & vbNewLine & _
Htm.getElementsByTagName("h4")(4).innerText & vbNewLine & _
"Master Tracking Number: " & Htm.getElementsByTagName("h3")(0).innerText & _
vbNewLine
theRegex.Pattern = "([0-9][A-z][0-9A-z][0-9][0-9][0-9][0-9][0-9A-z][0-9][0-9][0-9][0-9][0-9][0-9][0-9][0-9][0-9][0-9])"
Set MyMatches = theRegex.Execute(Htm.body.innerHTML)
If MyMatches.Count <> 0 Then
With MyMatches
For myMatchCt = 0 To .Count - 1
For subMtCt = 0 To .Item(subMtCt).SubMatches.Count - 1
Item = (.Item(myMatchCt).SubMatches.Item(subMtCt))
Tracking = Tracking & Trim(Item) & ","
Next
Next
End With
Else
End If
s = Split(Tracking, ",")
On Error Resume Next
For i = UBound(s) - 1 To 0 Step -1
myColl.Add s(i), CStr(s(i))
Next i
On Error Resume Next
ReDim s(LBound(s) To LBound(s) + myColl.Count - 1)
For i = 1 To myColl.Count
Debug.Print i & " " & myColl(i)
Next i
Set theRegex = Nothing
Set Htm = Nothing
Set MyMatches = Nothing
End Sub
答案 0 :(得分：0)
您可以从页面加载数据并使用正则表达式查找您想要的内容并加载到变量中。
使用xmlhttp尝试这种方式。编辑网址等。如果它似乎工作注释if / end if转储信息，即使看起来工作。它的vbscript但vbscript在vb6中工作。您可以通过添加它作为参考并制作文件和显式xmlhttp对象来优化它 - set file = new microsoft.xmlhttp
On Error Resume Next
Set File = WScript.CreateObject("Microsoft.XMLHTTP")
File.Open "GET", "http://www.microsoft.com/en-au/default.aspx", False
'This is IE 8 headers
File.setRequestHeader "User-Agent", "Mozilla/4.0 (compatible; MSIE 8.0; Windows NT 6.0; Trident/4.0; SLCC1; .NET CLR 2.0.50727; Media Center PC 5.0; .NET CLR 1.1.4322; .NET CLR 3.5.30729; .NET CLR 3.0.30618; .NET4.0C; .NET4.0E; BCD2000; BCD2000)"
File.Send
If err.number <> 0 then
line =""
Line = Line & vbcrlf & ""
Line = Line & vbcrlf & "Error getting file"
Line = Line & vbcrlf & "=================="
Line = Line & vbcrlf & ""
Line = Line & vbcrlf & "Error " & err.number & "(0x" & hex(err.number) & ") " & err.description
Line = Line & vbcrlf & "Source " & err.source
Line = Line & vbcrlf & ""
Line = Line & vbcrlf & "HTTP Error " & File.Status & " " & File.StatusText
Line = Line & vbcrlf & File.getAllResponseHeaders
wscript.echo Line
Err.clear
wscript.quit
End If
On Error Goto 0
Set BS = CreateObject("ADODB.Stream")
BS.type = 1
BS.open
BS.Write File.ResponseBody
BS.SaveToFile "c:\users\test.txt", 2
同时查看这些其他对象是否有效。
C:\Users>reg query hkcr /f xmlhttp
HKEY_CLASSES_ROOT \ Microsoft.XMLHTTP HKEY_CLASSES_ROOT \ Microsoft.XMLHTTP.1.0 HKEY_CLASSES_ROOT \ Msxml2.ServerXMLHTTP HKEY_CLASSES_ROOT \ Msxml2.ServerXMLHTTP.3.0 HKEY_CLASSES_ROOT \ Msxml2.ServerXMLHTTP.4.0 HKEY_CLASSES_ROOT \ Msxml2.ServerXMLHTTP.5.0 HKEY_CLASSES_ROOT \ Msxml2.ServerXMLHTTP.6.0 HKEY_CLASSES_ROOT \ MSXML2.XMLHTTP HKEY_CLASSES_ROOT \ Msxml2.XMLHTTP.3.0 HKEY_CLASSES_ROOT \ Msxml2.XMLHTTP.4.0 HKEY_CLASSES_ROOT \ Msxml2.XMLHTTP.5.0 HKEY_CLASSES_ROOT \ Msxml2.XMLHTTP.6.0 搜索结束：找到12个匹配项。