Showing posts with label dom. Show all posts
Showing posts with label dom. Show all posts

Wednesday, 17 January 2018

VBA - WebScraping - firing an HTML button's event from VBA with Click, FireEvent and Window.ExecScript

So, many questions on the StackOverflow VBA thread are concerned with web-scraping and so driving the browser in VBA code is a useful skill. Here we're see that we can push the boundary a little more by firing events in the HTML object model.

Code To Write HTML

Here we write some code to write the html file locally. The code uses the HtmlElementStack class (given separately below) to ensure our HTML is well-formed. There is a script tag which defines the function wired to the button's click handler. But we shall see that because the function is defined in the HTML page's global scope, i.e. Window object, then it can be called with Window.execScript


Private Const msFILENAME As String = "N:\TestJavascript2.html"

Function WriteHTML()

    Dim dicHTMLStack As HtmlElementStack
    Set dicHTMLStack = New HtmlElementStack

    With dicHTMLStack
        .SetFileName msFILENAME 
        
        .OE "html"
        .OE "head"
        .OE "title"
        .WL "Some test html with javascript"
        .CE
        .CE
        .OE "body"
        .OE "div", "id='div1'"
        .WL "Some Text"
        .CE
        .OE "button", "id='button1' type='button' onclick='throwMsgBox()'"
        .WL "Click Me!"
        .CE
        .OE "script", "language='jscript'"
        .WL "function throwMsgBox() { alert('hi there'); }"
        .CE
    End With
    
    Set dicHTMLStack = Nothing

End Function


HtmlElementStack class

This class allows us to be a little lazy when writing html files. We keep a stack, ie. Last In Last Out (LIFO) structure in a Scripting.Dictionary, that records all the open elements that need closing. It also manages its own text stream because we need to write off all pending close elements before the text stream is closed.


Option Explicit

'* Tools->References
' Scripting            Microsoft Scripting Runtime     C:\Windows\SysWOW64\scrrun.dll


Private mdicStack As New Scripting.Dictionary

Private mtxt As Scripting.TextStream
Private msFILENAME As String
Private mfso As New Scripting.FileSystemObject

'Private Sub SetStream(ByVal txt As Scripting.TextStream)
'    Set mtxt = txt
'End Sub

Public Sub SetFileName(ByVal sFileName As String)
    msFILENAME = sFileName
    Set mtxt = mfso.CreateTextFile(msFILENAME)
End Sub

Public Sub Write_(ByVal sText As String)
    mtxt.Write sText
End Sub

Public Sub WL(ByVal sText As String)
    mtxt.WriteLine sText
End Sub

Public Sub OE(ByVal sNodeName As String, Optional ByVal sAttribs As String)
    
    If Not mtxt Is Nothing Then
        If Len(sAttribs) = 0 Then
            mtxt.WriteLine "<" & sNodeName & ">"
        Else
            mtxt.WriteLine "<" & sNodeName & " " & sAttribs & ">"
        End If
    
        
    End If

    mdicStack.Add mdicStack.Count, sNodeName
    

End Sub

Public Sub CE()

    If mdicStack.Count > 0 Then
        Dim sLastNode As String
        sLastNode = mdicStack.Item(mdicStack.Count - 1)
        
        Call mdicStack.Remove(mdicStack.Count - 1)
    
        mtxt.WriteLine ""
    End If

End Sub

Private Sub Class_Terminate()

    While mdicStack.Count > 0
        DoEvents
        CE
        DoEvents
    Wend
    
    mtxt.Close

    Set mtxt = Nothing
End Sub


Code to drive IE and call the click handler function 3 different ways

So in this code we create an instance of IE and navigate to our newly written html file. We call the button's click handler function 3 different ways. Firstly, by navigating to element and call 'Click'. Secondly, by calling the function in the global scope (i.e. off the window object) using ExecScript. Thirdly, similar to first but a looser couple FireEvent method.

I recommend acquiring the element immediately before calling a method because I have witnessed a type of stale reference bug.


Private Const msFILENAME As String = "N:\TestJavascript2.html"

Public Sub TestFire()
    
'* Tools->References
'SHDocVw    Microsoft Internet Controls C:\Windows\SysWOW64\ieframe.dll
    
    Dim oIE As InternetExplorerMedium
    Set oIE = New InternetExplorerMedium
    
    oIE.Visible = True
    oIE.navigate msFILENAME
    While oIE.Busy Or oIE.readyState < 4
        DoEvents
    Wend
    
    
    Stop
    '* recommend re-acquiring element before using as I suspect IE suffers from stale references
    oIE.Document.getElementById("button1").Click
    
    Stop

    '* call the function via the global scope, for html global scope is the *window*
    Call oIE.Document.parentWindow.execScript("throwMsgBox()", "JavaScript")

    Stop
    
    '* recommend re-acquiring element before using as I suspect IE suffers from stale references
    oIE.Document.getElementById("button1").FireEvent "onclick"
    
    Stop
    
    
    oIE.Quit
End Sub


Links

Wednesday, 27 December 2017

Fake namespace! VBA MSXML2 XPath namespace looks like we need to fake a prefix for the default namespace

This is more a TODO post to myself to find a better solution to a VBA Xml programming program. Visitors are welcome to comment at the bottom if they know a better answer.

So a while ago, I had a problem with using XPath to get some elements out of an Xml Dom using VBA Xml library, MSXML2. You can see my SO question about it here. I expressed unhappiness about how we have to fake a prefix when setting the dom's SelectionNamespace.

Today a similar question arose but the twist here is that multiple namespaces have to be set. Here is my answer.

To set multiple namespaces simply space separate thus...


    dom.setProperty "SelectionNamespaces", "xmlns:sf='urn:sobject.enterprise.soap.sforce.com' xmlns:sf2='urn:enterprise.soap.sforce.com'"


(I omitted a couple of namespaces for formatting issues but you get the idea)

So I got some code working for the OP but I'd really like to find a way to not have to fake the prefix. In the source Xml note xmlns="urn:enterprise.soap.sforce.com" has no prefix but in our VBA we have to fake it with "sf2".

As a working resource I'm copying the Xml file here and the code below


<?xml version="1.0" encoding="UTF-8" ?>
<soapenv:Envelope xmlns:soapenv="http://schemas.xmlsoap.org/soap/envelope/" xmlns="urn:enterprise.soap.sforce.com" xmlns:sf="urn:sobject.enterprise.soap.sforce.com" xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance" >
  <soapenv:Header>
    <LimitInfoHeader>
      <limitInfo>
        <current>50</current>
        <limit>5000000</limit>
        <type>API REQUESTS</type>
      </limitInfo>
    </LimitInfoHeader>
  </soapenv:Header>
  <soapenv:Body>
    <queryResponse>
      <result>
        <done>true</done>
        <queryLocator xsi:nil="true"/>
        <records xsi:type="sf:Nodav">
          <sf:Id>a0S0E000000DMUg320</sf:Id>
          <sf:Name>Netta test 11</sf:Name>
        </records>
        <records xsi:type="sf:Nodav">
          <sf:Id>a0S0E000000DMUg321</sf:Id>
          <sf:Name>Netta test 32</sf:Name>
        </records>
        <size>2</size>
      </result>
    </queryResponse>
  </soapenv:Body>
</soapenv:Envelope>


Option Explicit


Sub TestCoreLogic()
    Dim dom As MSXML2.DOMDocument60
    Set dom = New MSXML2.DOMDocument60
    
    dom.Load "N:\xmlfile1.xml"
    Debug.Assert dom.parseError.ErrorCode = 0

    dom.setProperty "SelectionLanguage", "XPath"
    
    dom.setProperty "SelectionNamespaces", "xmlns:sf='urn:sobject.enterprise.soap.sforce.com' xmlns:sf2='urn:enterprise.soap.sforce.com' " & _
            "xmlns:soapenv='http://schemas.xmlsoap.org/soap/envelope/' xmlns:xsi='http://www.w3.org/2001/XMLSchema-instance' "
    
    CoreLogic dom
End Sub
'
Function CoreLogic(ByVal xmlDoc As MSXML2.DOMDocument60)

    Dim records As MSXML2.IXMLDOMElement
    Set records = xmlDoc.DocumentElement
    
    Dim lists As MSXML2.IXMLDOMNodeList
    
    'Debug.Assert records.SelectNodes("//soapenv:Envelope").Length = 1
    'Debug.Assert records.SelectNodes("//soapenv:Envelope/soapenv:Body").Length = 1
    'Debug.Assert records.SelectNodes("//soapenv:Envelope/soapenv:Body/sf2:queryResponse").Length = 1
    'Debug.Assert records.SelectNodes("//soapenv:Envelope/soapenv:Body/sf2:queryResponse/sf2:result").Length = 1
    '
    'Debug.Assert records.SelectNodes("//soapenv:Envelope/soapenv:Body/sf2:queryResponse/sf2:result/sf2:records").Length = 2
    'Set lists = records.SelectNodes("//soapenv:Envelope/soapenv:Body/sf2:queryResponse/sf2:result/sf2:records")
    
    Debug.Assert records.SelectNodes("//sf2:records").Length = 2
    Set lists = records.SelectNodes("//sf2:records")

    Dim listNode As MSXML2.IXMLDOMNode
    
    For Each listNode In lists
        Debug.Print "---Email---"
        
        Dim fieldNode As MSXML2.IXMLDOMNode
        For Each fieldNode In listNode.ChildNodes
            Debug.Print "[" & fieldNode.BaseName & "] = [" & fieldNode.Text & "]"
        Next fieldNode
    Next listNode

    Set records = Nothing
    Set lists = Nothing
    Set listNode = Nothing
    Set fieldNode = Nothing


End Function