我正在尝试创建一个较晚绑定的VBA项目来搜索网络。在某一时刻,我有以下代码(早期绑定(:
Dim currPage as HTMLDocument: Set currPage = objIE.document 'where objIE is set with Set objIE = CreateObject("InternetExplorer.application")
'(late bound as it is dim'd as Object)
Dim myDiv As HTMLDivElement: Set myDiv = currPage.getElementById("fbar")
Dim elemRect As IHTMLRect: Set elemRect = myDiv.getBoundingClientRect
'Scroll until bottom of page is in view
Do Until elemRect.bottom > 0
currPage.parentWindow.scrollBy 0, 10000
Set elemRect = myDiv.getBoundingClientRect
Loop
此代码在迟到时变为此:(或我想(
Dim currPage as Object: Set currPage = objIE.document
Dim myDiv As Object: Set myDiv = currPage.getElementById("fbar")
Dim elemRect As Object: Set elemRect = myDiv.getBoundingClientRect
'Scroll until bottom of page is in view
Do Until elemRect.bottom > 0
currPage.parentWindow.scrollBy 0, 10000
Set elemRect = myDiv.getBoundingClientRect
Loop
我猜这个问题在于 IHTMLRect
的I
,MSDN告诉我在网页上表示一个元素,该元素没有与之关联的实际对象 - 因此将其分配给未指定的Object
只是在代码中没有意义。(这是一个完整的猜测(
无论如何,早期绑定的代码正常工作,后期绑定的代码退出了elemRect.bottom
为什么要修复它?
VBA中的对象可以实现多个接口,并且可以调用的方法/属性取决于您使用的接口访问对象。一个简单的例子:
' This means access the object via the IUnknown interface
' IUnknown is the interface from which all other COM
' interfaces inherit
Dim x As IUnknown
Set x = ThisWorkbook.Worksheets(1)
' Commented out as this won't compile because the
' Name property isn't defined in IUnknown
' MsgBox x.Name
' This means access the object through the default
' interface associated with the Worksheet object type
Dim w As Worksheet
Set w = x
' Now we can get to the name (same object, different interface)
MsgBox w.Name
在MSHTML的情况下,我猜想getElementById
之类的方法正在返回像IHTMLElement
版本之一的界面。这意味着无法访问IHTMLDivElement
之类的接口中定义的方法/属性。
iunknown具有一种称为QueryInterface的方法,该方法用于获取对象实现的不同接口。但是,这不能直接在VBA中调用,因为这样做的VBA方法是将Dim
与适当的接口一起使用,然后使用Set
。这只有在设置了必要的引用后才进行编译,从而破坏了后期绑定的目的。
使用CallbyName有一个解决方法。要返回工作表示例,这有效:
Dim x As IUnknown
Set x = ThisWorkbook.Worksheets(1)
' Commented out as this won't compile because the
' Name property isn't defined in IUnknown
' MsgBox x.Name
' Can get to the property via CallByName
MsgBox CallByName(x, "Name", VbGet)
对于MSHTML问题,此功能(请注意,调用类型已更改为VbMethod
(:
Dim elemRect As Object: Set elemRect = CallByName(myDiv, "getBoundingClientRect",
VbMethod)
stTimer = Timer
'Scroll until bottom of page is in view
Do Until elemRect.bottom > 0 Or tElapsed > timeout 'timeout after n seconds
currPage.parentWindow.scrollBy 0, 10000
Set elemRect = CallByName(myDiv, "getBoundingClientRect", VbMethod)
tElapsed = Timer - stTimer
Loop
我对com对象一无所知,所以我可能没有考虑其他问题
完整的代码(从您的答案改编到另一个问题(。以快速连续运行该函数会导致IE由于花费时间关闭而产生错误(有关类似问题,请参见此问题(。如果需要连续运行多个查询,请重复使用相同的IE对象:
Option Explicit
Public Function GOOGLE_COUNT(searchTerm As String, xRes As Long, yRes As Long, Optional timeout As Long = 10) As Long
Dim url As String
Dim objIE As Object
Dim currPage As Object
Dim stTimer As Double, tElapsed As Single
Dim valueResult As Object
'create URL to page with these image criteria
url = "https://www.google.com/search?q=" & searchTerm & _
"&tbm=isch&source=lnt&tbs=isz:ex,iszw:" & xRes & ",iszh:" & yRes
'initiating a new instance of Internet Explorer and asigning it to objIE
Set objIE = CreateObject("InternetExplorer.Application")
'Google images search
objIE.navigate url
Do While objIE.Busy = True Or objIE.readyState <> 4: DoEvents: Loop
Set currPage = objIE.document
Dim myDiv As Object: Set myDiv = currPage.getElementById("fbar")
Dim elemRect As Object: Set elemRect = CallByName(myDiv, "getBoundingClientRect", VbMethod)
stTimer = Timer
'Scroll until bottom of page is in view
Do Until elemRect.bottom > 0 Or tElapsed > timeout 'timeout after n seconds
currPage.parentWindow.scrollBy 0, 10000
Set elemRect = CallByName(myDiv, "getBoundingClientRect", VbMethod)
tElapsed = Timer - stTimer
Loop
myDiv.ScrollIntoView
'Count the images
Set valueResult = currPage.getElementById("rg_s").getElementsByTagName("IMG")
GOOGLE_COUNT = valueResult.Length
objIE.Quit
End Function
Sub foo()
MsgBox GOOGLE_COUNT("St. Mary", 1366, 768)
End Sub