使用 Web 浏览器将值从 JavaScript 传递到 VBA

Question

我已经创建了一个示例，但我不知道如何使用 webbrowser 控件将值从 js 传递到 vba

Dim GetValFromJS As String

Private Sub UserForm_Initialize()
    Dim NEWHTML As String
    Dim i As Integer
    
    NEWHTML = "<HTML>"
    NEWHTML = NEWHTML & "<body>"
    For i = 1 To 5
        NEWHTML = NEWHTML & "<a href='#' onclick='return GetVal(" & i & ")'>" & i & "</a>"
        NEWHTML = NEWHTML & "<br>"
    Next i
    NEWHTML = NEWHTML & "<script type='text/javascript'>"
    NEWHTML = NEWHTML & "function GetVal(StrVal) {"
    NEWHTML = NEWHTML & "alert(StrVal);"
    '<---- how can i pass the value of StrVal to GetValFromJS
    NEWHTML = NEWHTML & "return false;"
    NEWHTML = NEWHTML & "}"
    NEWHTML = NEWHTML & "</script>"
    
    NEWHTML = NEWHTML & "</body>"
    NEWHTML = NEWHTML & "</html>"
    
    With WebBrowser1
        .Navigate2 "about:blank"
        .Document.Write NEWHTML
    End With
End Sub

而不是在 JS 中创建警报，我想将值从 JS 传递给 VB 变量，即 GetValFromJS

编辑

这是来自用户表单

Option Explicit
    
    Dim o As clsHtmlText '<< instance of our "withEvents" class
    
    Private Sub UserForm_Activate()
        Dim NewHTML As String
        Dim i As Integer
        
        Dim el As MSHTML.HTMLAnchorElement
        With Me.wb1
            .Navigate "about:blank"
            WaitFor wb1
            
        NewHTML = "<HTML>"
        NewHTML = NewHTML & "<body>"
        For i = 1 To 5
            NewHTML = NewHTML & "<a href='#' id='txtHere' onclick='return GetVal()' value='" & i & "'>" & i & "</a>"
            NewHTML = NewHTML & "<br>"
        Next i
        '<--- purpose of this script is not to reload the page
        NewHTML = NewHTML & "<script type='text/javascript'>"
        NewHTML = NewHTML & "function GetVal() {"
        NewHTML = NewHTML & "return false;"
        NewHTML = NewHTML & "}"
        NewHTML = NewHTML & "</script>"
    
        NewHTML = NewHTML & "</body>"
        NewHTML = NewHTML & "</html>"
            
            .Document.Open "text/html"
            'or you can load a page from a URL/file
            'Note: local pages need "mark of the web" in the markup
            '.Document.Write "<html><input type='text' size=10 id='txtHere'></html>"
            .Document.Write NewHTML
            .Document.Close
            WaitFor wb1
    
            Set el = .Document.getElementById("txtHere")
    
            Set o = New clsHtmlText
            o.SetText el '<< assign the textbox so we can monitor for change events
    
        End With
    
    End Sub
    
    'utility sub to ensure page is loaded and ready
    Sub WaitFor(IE)
        Do While IE.ReadyState < 4 Or IE.Busy
            DoEvents
        Loop
    End Sub

CLASS 模块：

Option Explicit

Private WithEvents txt As MSHTML.HTMLAnchorElement  '.HTMLInputElement

Public Sub SetText(el)
    Set txt = el
End Sub

Private Function txt_onclick() As Boolean
    MsgBox "changed: " & txt.Value
End Function

它正在工作:) 但只有第一个链接会触发消息框.. rest 不是

Answer 1

对于您的用户表单：

'You don't need a separate class if you're working in an 
'  "object" module (a form or sheet module for example)
Private WithEvents txt As MSHTML.HTMLInputElement

'This is triggered when the 'onchange' event fires for 
'  the input in the hosted webbrowser control
Private Function txt_onchange() As Boolean
    MsgBox "Value from web page:" & txt.Value
End Function


Private Sub UserForm_Activate()
    Dim html As String
    Dim i As Integer
    
    With Me.wb1
        .Navigate "about:blank"
        WaitFor wb1
        
        html = "<html><body>"
        For i = 1 To 5
            html = html & "<a href='#' id='txtHere' " & _
                   "onclick='SendVal(this);return false;'>Value " & i & "</a><br>"
        Next i
        
        html = html & "<input type='hidden' id='txtOutput' size='10'>" 'for sending data out
        html = html & "<script type='text/javascript'>"
        'set the input value and trigger its change event
        html = html & "function SendVal(el) {var txt=document.getElementById('txtOutput');" & _
                               "txt.value = el.innerText;txt.fireEvent('onchange');}"
        html = html & "</script></body></html>"
    
        .Document.Open "text/html"
        .Document.Write html
        .Document.Close
        WaitFor wb1
        
        Set txt = .Document.getElementById("txtOutput") 'set up event capture
    End With
End Sub
    
'utility sub to ensure page is loaded and ready
Sub WaitFor(IE)
    Do While IE.ReadyState < 4 Or IE.Busy
        DoEvents
    Loop
End Sub