vba截取internetexplorer链接点击

vba intercept internet explorer link click

本文关键字：链接 internetexplorer 截取 vba      更新时间：2024-01-23

我使用的是excel 2010，vba。我创建了一个网页，当用户点击链接时，我想截取该链接，并运行vba（而不是javascript onclick事件）。即如果可能的话，将onclick事件绑定到VBA函数或子函数。一些网站暗示这是可以做到的。自动化大师的问题。注意，我不想通过自动化点击链接（下面的代码就是这样做的）我希望用户点击，VBA拦截点击（注意，我也不想用更多的js替换javascript，我想调用VBA）。我正在使用InternetExplorer对象，但可能需要根据您的建议使用另一个ie对象或库引用。

下面的代码（示例）打开www的第一个网页并单击链接。我想截取这个点击并运行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

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

编辑：添加鼠标悬停/移出以进行良好测量。。。

常规模块

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（类模块）

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控件
  • Microsoft HTML对象库
相关文章：