(Excel VBA) - копировать содержимое веб-страницы в строку - PullRequest
Новая
       46

(Excel VBA) - копировать содержимое веб-страницы в строку

0 голосов
/ 13 февраля 2019

Мне нужно получить доступ к веб-страницам и скопировать их содержимое (все) в строку, из которой я затем извлеку некоторые цифры.

Адрес веб-страницы меняется каждый раз, так как я в основном обращаюсь к инструменту онлайн-моделирования иЯ должен указать параметры сима каждый раз.И на выходе всегда есть строка длиной около 320 символов.веб-страница состоит ТОЛЬКО из этого текста.

Пример веб-адреса / запроса: http://re.jrc.ec.europa.eu/pvgis5/PVcalc.php?lat=45&lon=8&peakpower=1&loss=14&optimalangles=1&outputformat=basic

Пример содержимого веб-страницы (строка для извлечения): 37 0 154,9 72,1 7,21 2 73,1 96,0 12,0 3 114 149 15,5 4 121 160 17,9 5 140 185 11,3 6 142 188 9,31 7 161 212 10,2 8 149 197 10,0 9 123 162 10,3 10 83,0 109 15,5 11 55,8 73,3 13,5 12 55,8 73,2 9,47 Год 1270 168058,8 потери AOI: 2,7% Спектральные эффекты: - Потеря температуры и низкой освещенности: 8,0% Совокупные потери: 24,1%

Вопрос к вам - Есть лиспособ скопировать эту строку без необходимости открывать и закрывать браузер каждый раз?Я должен повторить эту операцию (определить параметры запроса, извлечь относительную строку, извлечь нужные мне значения из строки) в общей сложности 7200 раз , когда я выполню свой анализ, и я бы хотел, чтобыбыть как можно более плавным и быстрым.

Примечание: мне не нужно сохранять текст строки в документе, но было бы нормально сделать это при необходимости, а затем открыть файл и получить мойстрока.Но это звучит так неэффективно, что я уверен, что должен быть лучший способ сделать это!

Ответы [ 3 ]

0 голосов
/ 13 февраля 2019

При таком количестве запросов было бы лучше использовать класс для хранения объекта xmlhttp, а не использовать функцию (где вы каждый раз создаете и уничтожаете объект).Затем запустите подпрограмму, которая передает все URL-адреса этому объекту.Укажите в классе метод для возврата строки.

Модуль класса: clsHTTP

Option Explicit  
Private http As Object

Private Sub Class_Initialize()
    Set http = CreateObject("MSXML2.XMLHTTP")
End Sub

Public Function GetString(ByVal url As String) As String
    Dim sResponse As String
    With http
        .Open "GET", url, False
        .send
        GetString = .responseText
    End With
End Function

Стандартный модуль 1: 

Option Explicit 
Public Sub GetStrings()
    Dim urls, ws As Worksheet, i As Long, http As clsHTTP
    Set ws = ThisWorkbook.Worksheets("Sheet1")
    Set http = New clsHTTP
    'read in from sheet the urls
    urls = Application.Transpose(ws.Range("A1:A2").Value) 'Alter range to get all urls
    Application.ScreenUpdating = False
    For i = LBound(urls) To UBound(urls)
        ws.Cells(i, 2) = http.GetString(urls(i))
    Next
    Application.ScreenUpdating = True
End Sub
0 голосов
/ 16 февраля 2019

Я использую приведенные ниже варианты функций постоянно для таких вещей, как извлечение html с веб-страницы или JSON-результаты запроса API и многое другое.

Поздняя версия

Эта "автономная" версия не требует ссылок : 

Public Function getHTTP(ByVal url As String) As String
'returns HTML from URL (works on *almost* any URL you throw at it)
    With CreateObject("MSXML2.XMLHTTP")
        .Open "GET", url, False
        .Send
        getHTTP = StrConv(.responseBody, vbUnicode)
    End With
End Function

Ранняя версия

Если вы собираетесь использовать несколько сайтов, более эффективно ( в два раза быстрее и намного проще для системных ресурсов) использовать эту версию.Вам нужно будет добавить ссылку на библиотеку MS XML ( Инструменты → Ссылки → Microsoft XML, v6.0).

Public Function getHTTP(ByVal url As String) As String  
'Returns HTML from a URL, early bound (requires reference to MS XML6)
    Dim msXML As New XMLHTTP60
    With msXML
        .Open "GET", url, False
        .Send
        getHTTP = StrConv(.responseBody, vbUnicode)
    End With
    Set msXML = Nothing
End Function

Возврат только текста

При использовании указанных выше функций для вызова веб-страницы они возвращают необработанный исходный код HTML.Вы можете убрать теги HTML и остаться только с «простой текстовой» версией страницы с этой изящной функцией из Тим Уильямс : 

Function HtmlToText(sHTML) As String
'requires reference: Tools → References → "Microsoft HTML Object Library"
    Dim oDoc As HTMLDocument
    Set oDoc = New HTMLDocument
    oDoc.body.innerHTML = sHTML
    HtmlToText = oDoc.body.innerText
End Function

Пример:

Собрав его вместе, приведенный ниже пример возвращает простой текст "этой" веб-страницы. 

Option Explicit
'requires reference: Tools > References > "Microsoft HTML Object Library"

Function HtmlToText(sHTML) As String
    Dim oDoc As HTMLDocument
    Set oDoc = New HTMLDocument
    oDoc.body.innerHTML = sHTML
    HtmlToText = oDoc.body.innerText
End Function

Public Function getHTTP(ByVal url As String) As String
    With CreateObject("MSXML2.XMLHTTP")
        .Open "GET", url, False
        .Send
        getHTTP = StrConv(.responseBody, vbUnicode)
    End With
End Function

Sub Demo()
    Const url = "https://stackoverflow.com/questions/54670251"
    Dim html As String, txt As String

    html = getHTTP(url)
    txt = HtmlToText(html)

    Debug.Print txt & vbLf  'Hit CTRL+G to view output in Immediate Window
    Debug.Print "HTML source = " & Len(html) & " bytes"
    Debug.Print "Plain Text  = " & Len(txt) & " bytes"
End Sub

Дополнительная информация:

0 голосов
/ 13 февраля 2019

Да, есть способ сделать это без использования Internet Explorer, вы можете использовать веб-запрос.

Вот пример метода.По сути, вы эмулируете связь, которая обычно происходит между браузером и сервером. 

Option Explicit

Public Function getPageText(url As String)
    With CreateObject("MSXML2.XMLHTTP")
        .Open "GET", url
        .send
        getPageText = .responseText
    End With
End Function

Sub Example()
    Dim url As String: url = "http://re.jrc.ec.europa.eu/pvgis5/PVcalc.php?lat=45&lon=8&peakpower=1&loss=14&optimalangles=1&outputformat=basic"
    Debug.Print getPageText(url)
End Sub
...