VBA: Error while opening Website

Question

I shortened the code for better visibility:

Sub open_explorer()

    'Open Website 1
    Set IE = CreateObject("InternetExplorer.Application")

    IE.navigate ("https://www.google.ch/search?newwindow=0&q=Dodecan+Sigma-Aldrich")
    IE.Visible = True

    i = 0
    Do
        Wait
        i = i + 1
    Loop Until IE.ReadyState = 4 Or i > 10

    Set dom = IE.document
    Debug.Print (dom)
    Debug.Print (dom.anchors.Length)

    'Open Website 2
    Set IE = CreateObject("InternetExplorer.Application")

    IE.navigate ("https://www.sigmaaldrich.com/catalog/product/sial/457116?lang=en&region=US")
    IE.Visible = True

    i = 0
    Do
        Wait
        i = i + 1
    Loop Until IE.ReadyState = 4 Or i > 10

    Set dom = IE.document
    Debug.Print (dom)
    Debug.Print (dom.anchors.Length)

End Sub

Sub Wait()
    Application.Wait (Now + TimeValue("0:00:01"))
End Sub

As you can see the Sub open_explorer opens two websites and tries to read its DOM. However while the code perfectly works for the first website it doesn't for the second although the code is the same. Any Ideas why it doesn't work for the second website?

Answer 1

I think as a minimum put Option Explicit at the top of all your modules. Then in this code declare all your variables and their types. The following works for me.

Note:

If the browser is blocking it a request in the same origin for security reasons. you will need to do something different for a cross-domain request. More info on that here Using CORS.²

Code:

Option Explicit

Sub open_explorer()

    Dim Ie As Object
    'Open Website 1
    Set Ie = CreateObject("InternetExplorer.Application")

    Ie.navigate ("https://www.google.ch/search?newwindow=0&q=Dodecan+Sigma-Aldrich")
    Ie.Visible = True

    Dim i As Long
    i = 0
    Do
        Wait
        i = i + 1
    Loop Until Ie.ReadyState = 4 Or i > 10
    Dim dom As Object
    Set dom = Ie.document
    Debug.Print (dom)
    Debug.Print (dom.anchors.Length)

    'Open Website 2
    Set Ie = CreateObject("InternetExplorer.Application")

    Ie.navigate ("https://www.sigmaaldrich.com/catalog/product/sial/457116?lang=en&region=US")
    Ie.Visible = True

    i = 0
    Do
        Wait
        i = i + 1
    Loop Until Ie.ReadyState = 4 Or i > 10

    Set dom = Ie.document
    Debug.Print (dom)
    Debug.Print (dom.anchors.Length)

End Sub

Sub Wait()
    Application.Wait (Now + TimeValue("0:00:01"))
End Sub

Result:

References:

1. What do Option Strict and Option Explicit do?
2. Why does my JavaScript get a "No 'Access-Control-Allow-Origin' header is present on the requested resource" error when Postman does not?

Answer 2

I don't know why it works for you. I corrected the "Option Explicit" header but this didn't resolve the CORS-Bug.

HOWEVER, I wrote a little PHP-snipped for my server to load the URL:

<?php

$link = urldecode( $_GET['link'] );

$file = file_get_contents( $link );

echo $file;

Now loading the link indirectly works perfectly.