Surfing the web via Excel: dealing with site modal window

[Nelson78]

Hello everybody.

I'm in troubles while surfing a web site: the deadlock is the modal window you can see in the image.

https://imgur.com/a/iq4KSDY

It absolutely blocks every Excel actions: I've to manually click "OK" in order to unblock the process.

I've tried the following solution, but unsuccessfully.

(the red line is the instruction triggering the window.

Option Explicit
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
(ByVal hWND As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long

Public Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
(ByVal lpClassName As String, ByVal lpWindowName As String) As Long

Public Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" _
(ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, _
ByVal lpsz2 As String) As Long

Public Const BM_CLICK = &HF5&



Sub navigatewebsite()

'do stuff: login to the site and navigating

Dim i As Long, hWND As Long, childHWND As Long
'class = rgRow
Dim elements As Object
    Set elements = HTMLdoc.getElementsByClassName("rgRow")
Dim ele As Object

    For Each ele In elements
        
        If ele.innerText = "3625" Or "3626" Or "3628" Or "3630" Or _
            "3631" Or "3649" Or "3651" Or "3658" Or "6376" Or _
            "3627" Or "3650" Or "3659" Or "3652" Then

                 [COLOR="#FF0000"][B]ele.Click[/B][/COLOR]
 
                               While IE.Busy Or IE.readyState <> READYSTATE_COMPLETE     
                                DoEvents                                               
    
                                      If IE.Busy Then
                                             DoEvents
                                             hWND = FindWindow(vbNullString, "Messaggio della pagina Web")
                                                        If hWND <> 0 Then childHWND = FindWindowEx(hWND, ByVal 0&, "Button", "OK")
                                                        If childHWND <> 0 Then SendMessage childHWND, BM_CLICK, 0, 0
                                      End If
                
                               Wend

           Exit For
        End If   'end If ele.innerText
    Next ele

'do stuff

end sub

Probably the approach is wrong: may be I need to work with two Excel instances or something like that?

Thank's in advance for your suggestion.

 

[John_w]

It looks like a JavaScript Confirm box. Have you tried changing the element's o_nclick attribute and then clicking it? See https://www.mrexcel.com/forum/excel...essage-box-popup-post2109894.html#post2109894

 

[Nelson78]

It seems harder.
I cannot find any o-nclick in the html.

The popup is probably triggered via the following function:

function RowS (sender, args) {

                        var sSite = document.getElementById("cSite").control._value;
            if (sSite == "")
                sSite = 0;
            var sTeam = document.getElementById("cTeam").control._value;
            if (sTeam == "")
                sTeam = 0;
            var Export_Type = ".xls";
            if (confirm(' Vuoi esportare i dati in un file Excel (.xls)?')) {
                xmlDocF = new ActiveXObject("Microsoft.XMLDOM");
                xmlDocF.async = false;
                xmlDocF.load("azClient.xml")
                WebMethod(xmlDocF, "SaveExport")
                NewField(xmlDocF, "idMarket", document.getElementById("hidIdMarket").value)
                NewField(xmlDocF, "type", 'output')
                NewField(xmlDocF, "date_from", document.getElementById("DayPicker1").value)
                NewField(xmlDocF, "date_to", document.getElementById("DayPicker2").value)
                NewField(xmlDocF, "id_type", args.getDataKeyValue("code1"))
                NewField(xmlDocF, "idSite", sSite)
                NewField(xmlDocF, "idTeam", sTeam)
                NewField(xmlDocF, "idLogin", document.getElementById("hidLogin").value)
                NewField(xmlDocF, "Export_Type", Export_Type)
                NewField(xmlDocF, "idMarket", document.getElementById("hidIdMarket").value)
                NewField(xmlDocF, "level", '1')
                WsAdminService.wsadmin.GeneralMethodOutsourcer(xmlDocF.documentElement.xml, OnCompleteCreaExport, OnFail);
            }
        }

 

[John_w]

I've don't know if this will work because I've never done it before, but if the script is in the HTMLdocument and not a separate .js file you could try changing the "if (confirm(....))" to "if (true)" like this:

    Dim HTMLdoc As HTMLDocument
    Set HTMLdoc = IE.document
    Dim script As HTMLScriptElement
    Dim p1 As Long, p2 As Long
    Set script = HTMLdoc.getElementById("the script id")    'or getElementsByTagName, etc.
    p1 = InStr(1, script.outerHTML, "if (confirm(", vbTextCompare)
    If p1 > 0 Then
        p2 = InStr(p1, script.outerHTML, "))")
        script.outerHTML = Left(script.outerHTML, p1 - 1) & "if (true)" & Mid(script.outerHTML, p2 + 2)
    End If

and then trigger the element which runs the script.

 

[Nelson78]

I've don't know if this will work because I've never done it before, but if the script is in the HTMLdocument and not a separate .js file you could try changing the "if (confirm(....))" to "if (true)" like this:

    Dim HTMLdoc As HTMLDocument
    Set HTMLdoc = IE.document
    Dim script As HTMLScriptElement
    Dim p1 As Long, p2 As Long
    Set script = HTMLdoc.getElementById("the script id")    'or getElementsByTagName, etc.
    p1 = InStr(1, script.outerHTML, "if (confirm(", vbTextCompare)
    If p1 > 0 Then
        p2 = InStr(p1, script.outerHTML, "))")
        script.outerHTML = Left(script.outerHTML, p1 - 1) & "if (true)" & Mid(script.outerHTML, p2 + 2)
    End If

and then trigger the element which runs the script.

I cannot find reference to the script such as

Set script = [COLOR="#FF0000"]HTMLdoc.getElementById[/COLOR]("the script id")    'or [COLOR="#FF0000"]getElementsByTagName[/COLOR], etc.

I need some more hints.

Where should I search?

 

[John_w]

Did you change "the script id" to the actual id attribute of the script?

Another way, if the script has a name attribute, is:

Set script = HTMLdoc.getElementsByName("the script name")(0)

assuming the script is the first (0th) element with name="the script name".

Otherwise, loop through the HTMLDocument.Scripts collection looking for some text in the script, by replacing the Set script line with:

    Dim i As Long
    i = 0
    While i < HTMLdoc.scripts.Length And script Is Nothing
        If InStr(1, HTMLdoc.scripts(i).outerHTML, "function RowS", vbTextCompare) Then Set script = HTMLdoc.scripts(i)
        i = i + 1
    Wend

Remember, you need to set a reference to MS HTML Object Library, which I always recommend when developing code.

 

[Nelson78]

I've been narrowing the working area, but something is getting wrong.

Below some of the reference points:

Looping in the HTML document, we can detect 38 times the string

<scrip_t

we have to work on the 6th occurrence.

This is its framework of the 6th occurence:
- start with

<scrip_t type="text/javascript" language="javascript">

- ending with

</scrip_t>

- number of characters: beyond 8000
- number of functions: 7
- function we have to manipulate: the 2nd
- the string if (confirm('Vuoi esportare i dati in un file Excel (.xls)?')) is detected 4 times

Maybe there is something wrong in identifying the values of p1 and p2.

ps Of course, it is an intranet site not surfable from outside the company.

 

[John_w]

My last code looks for the script containing "function RowS", so it should find your script. However I've now tested my previous code on a real HTML page and it should change script.innerHTML, not outerHTML. Changing outerHTML just results in open and close script tags with nothing inside. Here is the complete code.

    Dim script As HTMLScriptElement
    Dim i As Long
    Dim p1 As Long, p2 As Long
    
    i = 0
    Set script = Nothing
    While i < HTMLdoc.Scripts.Length And script Is Nothing
        If InStr(1, HTMLdoc.Scripts(i).outerHTML, "function RowS", vbTextCompare) Then Set script = HTMLdoc.Scripts(i)
        i = i + 1
    Wend
    
    If Not script Is Nothing Then
        p1 = InStr(1, script.innerHTML, "if (confirm(", vbTextCompare)
        If p1 > 0 Then
            p2 = InStr(p1, script.innerHTML, "))")
            script.innerHTML = Left(script.innerHTML, p1 - 1) & "if (true)" & Mid(script.innerHTML, p2 + 2)
            MsgBox script.outerHTML
        End If
    Else
        MsgBox "Script not found"
    End If

 

[Nelson78]

My last code looks for the script containing "function RowS", so it should find your script. However I've now tested my previous code on a real HTML page and it should change script.innerHTML, not outerHTML. Changing outerHTML just results in open and close script tags with nothing inside. Here is the complete code.

    Dim script As HTMLScriptElement
    Dim i As Long
    Dim p1 As Long, p2 As Long
    
    i = 0
    Set script = Nothing
    While i < HTMLdoc.Scripts.Length And script Is Nothing
        If InStr(1, HTMLdoc.Scripts(i).outerHTML, "function RowS", vbTextCompare) Then Set script = HTMLdoc.Scripts(i)
        i = i + 1
    Wend
    
    If Not script Is Nothing Then
        p1 = InStr(1, script.innerHTML, "if (confirm(", vbTextCompare)
        If p1 > 0 Then
            p2 = InStr(p1, script.innerHTML, "))")
            script.innerHTML = Left(script.innerHTML, p1 - 1) & "if (true)" & Mid(script.innerHTML, p2 + 2)
            MsgBox script.outerHTML
        End If
    Else
        MsgBox "Script not found"
    End If

Of course, it finds the correct script.

The hitch is now Run-time errror 600 Application-defined or object-defined error in the line

script.innerHTML = Left(script.innerHTML, p1 - 1) & "if (true)" & Mid(script.innerHTML, p2 + 2)

I'm struggling to find some information in the web about this error.

 

[John_w]

In that case it might not be possible to rewrite the HTML.

What are you actually trying to do, as the final outcome? It looks like the JavaScript is downloading a .xls file, and it might be possible to bypass IE automation altogether and use XMLhttp/WinHttp to download the file, by sending the exact requests that IE would send. There are examples on the forum showing how to do this.

Staying with IE automation, another way of closing the pop-up, if you are allowed to install third-party tools, is Orlando's SendKeys.exe - http://cpap.com.br/orlando/SendKeysMore.asp. You would run it as Shell process, before the pop-up opens, so it is independent of Excel and would not be blocked.