延迟绑定IHTML元素



我正在尝试创建一个较晚绑定的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

我猜这个问题在于 IHTMLRectI,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

最新更新