VBA: ошибка при открытии веб-сайта - PullRequest
0 голосов
/ 01 мая 2018

Я сократил код для лучшей видимости:

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

Как видите, Sub open_explorer открывает два веб-сайта и пытается прочитать его DOM. Однако, хотя код отлично работает для первого сайта, он не работает для второго, хотя код тот же. Любые идеи, почему это не работает для второго сайта?

Error-Message

Ответы [ 2 ]

0 голосов
/ 02 мая 2018

Я не знаю, почему это работает для вас. Я исправил заголовок «Option Explicit», но это не разрешило ошибку CORS.

ОДНАКО, я написал немного PHP-кода для моего сервера для загрузки URL:

<?php

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

$file = file_get_contents( $link );

echo $file;

Теперь загрузка ссылки косвенно работает отлично.

0 голосов
/ 01 мая 2018

Думаю, как минимум, поставить Option Explicit на вершину всех ваших модулей. Затем в этом коде объявите все ваши переменные и их типы. Следующее работает для меня.

Примечание:

Если браузер блокирует запрос в том же источнике из соображений безопасности. вам нужно будет сделать что-то другое для междоменного запроса. Подробнее об этом здесь Использование CORS . 2

Код:

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

Ссылка:

  1. Что делают Option Strict и Option Explicit?
  2. Почему мой JavaScript получает сообщение об ошибке «Отсутствует заголовок« Access-Control-Allow-Origin »на запрошенном ресурсе», а у Postman - нет? »
...