vba 拦截 Internet Explorer link 点击

Question

我正在使用 excel 2010，vba。我有一个网页在工作——我创建的，当用户点击 link，我想拦截那个 link，和运行 vba（不是javascript onclick 事件）。即，如果可能，将 onclick 事件绑定到 VBA 函数或子函数。一些网站暗示它可以完成。自动化大师的问题。请注意，我不想通过自动化点击 link（下面的代码执行此操作）我希望用户点击并且 VBA 拦截点击（注意，我不想替换 javascript 我想调用更多的 js VBA)。我正在使用 InternetExplorer 对象，但可能需要按照您的建议使用另一个 ie 对象或库引用。

下面的代码（示例）打开 www 的第一个网页并单击 link。我想拦截这个点击和运行 vb 代码。

Dim ie As InternetExplorer
Set ie = New InternetExplorer
sURL = "http://info.cern.ch/hypertext/WWW/TheProject.html" ' www's first web page

ie.Navigate sURL
ie.Visible = True
Do While ie.Busy
    DoEvents
Loop
Set oForm = ie.Document.getElementsByName("0") ' worlds first ever anchor/ hyper link
Set oLink = oForm.Item(0)

'oLink.onclick = ' set/add to VBA function to replace/set javascript onlclick event ie. to intercept click

oForm.Item(0).Click ' run vba code to display msgbox "hello World" not navigate

Answer 1

您可以使用 class 模块和 WithEvents 连接 VBA 托管的事件，这些事件可以从 IE 触发。此代码用于链接，但也可以捕获大多数其他事件。

编辑：已添加 mouseover/out 以备不时之需...

常规模块

Private lnks As Collection 'of clsLink

Sub Tester()

    Dim ie As InternetExplorer, el, sURL
    Dim lnk As clsLink

    Set ie = New InternetExplorer
    sURL = "http://info.cern.ch/hypertext/WWW/TheProject.html" 

    ie.Navigate sURL
    ie.Visible = True
    Do While ie.Busy
        DoEvents
    Loop

    Set lnks = New Collection

    For Each el In ie.document.getElementsByTagName("a")
        Set lnk = New clsLink
        lnk.Init el
        lnks.Add lnk
    Next

End Sub

clsLink（class 模块）

Option Explicit

'note "WithEvents" declaration
Private WithEvents lnk As MSHTML.HTMLAnchorElement

Private Function lnk_onclick() As Boolean
    Debug.Print "Link: '" & lnk.innerText & "' clicked!"
    lnk_onclick = False 'cancels navigation
    'lnk_onclick = True 'doesn't cancel navigation
End Function

Private Sub lnk_onmouseout()
    With lnk.Style
        .Color = "#00F"
        .backgroundColor = "#FFF"
    End With
End Sub

Private Sub lnk_onmouseover()
    With lnk.Style
        .Color = "#F00"
        .backgroundColor = "#0F0"
    End With
End Sub

Public Sub Init(el)
    Set lnk = el
End Sub

将项目引用添加到：

Microsoft Internet 控件
微软HTML对象库

vba 拦截 Internet Explorer link 点击

vba intercept internet explorer link click

javascript

excel

internet-explorer

automation

vba