Surfing the web via Excel: dealing with site modal window

Nelson78

Well-known Member
Joined
Sep 11, 2017
Messages
525
Office Version
  1. 2007
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.

Code:
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.
 
Last edited:

Excel Facts

Pivot Table Drill Down
Double-click any number in a pivot table to create a new report showing all detail rows that make up that number
It seems harder.
I cannot find any o-nclick in the html.

The popup is probably triggered via the following function:


Code:
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);
            }
        }
 
Last edited:
Upvote 0
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:
Code:
    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.
 
Upvote 0
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:
Code:
    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

Code:
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?
 
Last edited:
Upvote 0
Did you change "the script id" to the actual id attribute of the script?

Another way, if the script has a name attribute, is:
Code:
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:
Code:
    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.
 
Upvote 0
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
Code:
<scrip_t
we have to work on the 6th occurrence.

This is its framework of the 6th occurence:
- start with
Code:
<scrip_t type="text/javascript" language="javascript">
- ending with
Code:
</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.
 
Last edited:
Upvote 0
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.

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
 
Upvote 0
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.

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

Code:
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.
 
Upvote 0
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.
 
Upvote 0

Forum statistics

Threads
1,213,565
Messages
6,114,338
Members
448,570
Latest member
rik81h

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top