Vba получить html код страницы

Загрузка кода страницы с сайта в эксель

Добрый день.
Есть задача: извлечь информацию с некоторых страниц из интернета.

Пользуюсь таким скриптом для передачи кода страницы в string:

sURL = "http://instagram.com/Ballantines_Russia" Set oXMLHTTP = CreateObject("MSXML2.XMLHTTP") With oXMLHTTP .Open "GET", sURL, False .send Application.Wait Now + 5 / 86400 txt = .responseText End With Set oXMLHTTP = Nothing

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

Попробовал другим методом- так же не получилось ( даже запрос разный-мне удобен код страницы, а второй алгоритм выдает текст со страницы):

Dim ieDoc As MSHTML.HTMLDocument Dim objCollectionIf As Object Set IE = CreateObject("InternetExplorer.Application") IE.Navigate sURL While IE.busy Or (IE.readyState <> 4) DoEvents Wend Set ieDoc = IE.Document Sheets(DM).Select ActiveSheet.Cells(2, 1) = ieDoc.innerHTML

Подскажите, каким способом лучше воспользоваться?
Во вложении- мой скрипт и результат его работы. Мне нужно увидеть, сколько followers-ов . В примере можно увидеть, что там этого значения нет

Если же метод позволит сначала логиниться, а потом получать код странички- то вообще замечательно.

Загрузка кода страницы HTTPS с сайта в эксель
Пользуюсь вот этим: Public Function GetHTTPResponse(ByVal sURL As String) As String On.

Извлечение данных с сайта и загрузка этих данных в эксель
Всем доброго суток. Вопрос такого плана. Есть подраздел на сайте. В качестве примера рассмотрим.

Загрузка исходного кода страницы
Я думаю все знают, что можно в браузере просматривать исходный код. Правой кнопкой мыши по.

Загрузка страницы сайта в txt документ
Здравствуйте, хотелось бы узнать можно ли с помощью c# скачать страницу с сайта в txt документ, а.

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25

Sub GetInstagramStat() Dim sURL, oXMLHTTP As MSXML2.XMLHTTP, txt sURL = "http://instagram.com/Ballantines_Russia" Set oXMLHTTP = CreateObject("MSXML2.XMLHTTP") With oXMLHTTP .Open "GET", sURL, False .send If .Status = 200 Then txt = .responseText Dim h As Long, p As Long, posts, followers, following p = InStr(1, txt, " posts", 1) h = InStr(p - 9, txt, """>", 1) + 2 posts = Mid(txt, h, p - h) p = InStr(1, txt, " followers", 1) h = InStr(p - 9, txt, """>", 1) + 2 followers = Mid(txt, h, p - h) p = InStr(1, txt, " following", 1) h = InStr(p - 9, txt, """>", 1) + 2 following = Mid(txt, h, p - h) End If End With Set oXMLHTTP = Nothing end Sub

P.S. Application.Wait лишнее, т.к. запрос у Вас не асинхронный и код все равно не перейдет на следующую строку, пока не получит результат от страницы. А вот проверять статус, чтобы убедиться в том, что страница загружена все же не помешает.

Дмитрий, привет.
Спасибо за ответ.
Задержку- убрал. Так даже быстрее.
Попробовал ваш скрипт- ругается на

Dim sURL, oXMLHTTP As MSXML2.XMLHTTP, txt

User-defined type not defined. Эта строка- объявление типов, и не обязательна ( как мне кажется). Без неё скрипт выполнился, но.

Проверил я ещё на одном компьютере.
И мой, и ваш скрипт- работают, но на одном из двух моих компьютеров. На обоих- win7, на одном IE8, на другом (на котором работает нормально) IE11.

Есть идеи- почему так может быть и как заставить работать стабильно?

Источник

VBA Excel. Парсинг сайтов, html-страниц и файлов

Пользовательская функция GetHTML1 (VBA Excel) для извлечения (парсинга) текстового содержимого из html-страницы сайта по ее URL-адресу с помощью объекта «msxml2.xmlhttp»:

Парсинг сайтов (WinHttp.WinHttpRequest.5.1)

Парсинг файлов (ADODB.Stream)

Примеры записи текста в переменную

Извлечение данных из html

В понятие «парсинг», кроме извлечения текстового содержимого сайтов, html-страниц или файлов, входит поиск и извлечение конкретных данных из всего полученного текстового содержимого. Пример извлечения email-адресов из текста, присвоенного переменной, смотрите в последнем параграфе статьи: Регулярные выражения (объекты, свойства, методы).

Парсинг содержимого тегов

Парсинг содержимого Id

Для реализации представленных здесь примеров могут понадобиться дополнительные библиотеки. В настоящее время у меня подключены следующие (к данной теме могут относиться последние шесть):

• Visual Basic For Applications
• Microsoft Excel 16.0 Object Library
• OLE Automation
• Microsoft Office 16.0 Object Library
• Microsoft Forms 2.0 Object Library
• Ref Edit Control
• Microsoft Scripting Runtime
• Microsoft Word 16.0 Object Library
• Microsoft Windows Common Controls 6.0 (SP6)
• Microsoft ActiveX Data Objects 6.1 Library
• Microsoft ActiveX Data Objects Recordset 6.0 Library
• Microsoft HTML Object Library
• Microsoft Internet Controls
• Microsoft Shell Controls And Automation
• Microsoft XML, v6.0

С этим набором библиотек все примеры работают. Тестирование проводилось в VBA Excel 2016.

6 комментариев для “VBA Excel. Парсинг сайтов, html-страниц и файлов”

Доброго дня, коллеги.
Задача следующая: в элементе ВэбБраузерКонтрол на странице поиска выполняю определенный запрос и визуально убедившись в получении нужного результата начинаю парсить содержимое. Вопрос как получить текстовое содержимое элемента ВэбБраузерКонтрол в момент когда там отображена нужная информация.
Заранее спасибо.

Доброго дня!
При попытке вычислить к примеру первое вхождение, ищет все равно следующее почему то. Sub Primer1()
Dim myHtml As String, myFile As Object, myTag As Object, myTxt As String
‘Извлекаем содержимое html-страницы в переменную myHtml с помощью функции GetHTML1
myHtml = GetHTML1(«https://bik-info.ru?040702802»)
‘Создаем объект HTMLFile
Set myFile = CreateObject(«HTMLFile»)
‘Записываем в myFile текст из myHtml
myFile.body.innerHTML = myHtml
‘Присваиваем переменной myTag коллекцию одноименных тегов, имя которого
‘указанно в качестве аргумента метода getElementsByTagName
Set myTag = myFile.getElementsByTagName(«strong»)
‘Выбираем, содержимое какого тега по порядку, начинающегося с 0, нужно извлечь
myTxt = myTag(0).innerText
Debug.Print myTxt
‘Большой текст может не уместиться в MsgBox, тогда для просмотра используйте окно Immediate
‘Debug.Print myTxt
End Sub Function GetHTML1(ByVal myURL As String) As String
On Error Resume Next
With CreateObject(«msxml2.xmlhttp»)
.Open «GET», myURL, False
.send
Do: DoEvents: Loop Until .readyState = 4
GetHTML1 = .responseText
End With
End Function

Здравствуйте, Сергей!
На HTML-странице, которую вы указали, тегом strong выделены только две одинаковые даты. Предположу, что отображается первая дата. Если strong заменить на b , отобразится знак $ , который идет первый с этим тегом.

Источник

Скачивание исходного кода web-страницы в текстовый файл

Данная функция возвращает исходный текст web-страницы:

Function GetHTTPResponse(ByVal sURL As String) As String On Error Resume Next Set oXMLHTTP = CreateObject("MSXML2.XMLHTTP") With oXMLHTTP .Open "GET", sURL, False ' раскомментируйте следующие строки и подставьте верные IP, логин и пароль ' если вы сидите за proxy ' .setProxy 2, "192.168.100.1:3128" ' .setProxyCredentials "user", "password" .send GetHTTPResponse = .responseText End With Set oXMLHTTP = Nothing End Function

Пример использования функции GetHTTPResponse

Private Sub ПримерИспользованияФункции_GetHTTPResponse() ' считываем исходный текст страницы ExcelVBA.ru в переменную txt txt = GetHTTPResponse("http://ExcelVBA.ru") ' получаем путь к папке "Рабочий стол" ПутьКРабочемуСтолу = CreateObject("WScript.Shell").SpecialFolders("Desktop") ' сохраняем текст из переменной txt в файл PageText.txt на рабочем столе SaveTXTfile ПутьКРабочемуСтолу & "\PageText.txt", txt ' открываем созданный текстовый файл в Excel Workbooks.OpenText ПутьКРабочемуСтолу & "\PageText.txt" End Sub Function SaveTXTfile(ByVal filename As String, ByVal txt As String) As Boolean On Error Resume Next: Err.Clear Set fso = CreateObject("scripting.filesystemobject") Set ts = fso.CreateTextFile(filename, True) ts.Write txt: ts.Close SaveTXTfile = Err = 0 Set ts = Nothing: Set fso = Nothing End Function

PS: Если вас интересует ТЕКСТ страницы — используйте эту функцию: http://excelvba.ru/code/GetWebPageText

Еще один вариант кода — где можно задать таймаут
(чтобы код не подвисал, если нет ответа от сайта в течение нескольких секунд)

ВНИМАНИЕ: Надо подключить в Tools — References библиотеку Microsoft WinHTTP Services 5.1

Const TIMEOUT& = 6 ' в секундах Function GetResponse(ByVal URL$) As String On Error Resume Next: Err.Clear Static xmlhttp As WinHttpRequest If xmlhttp Is Nothing Then Set xmlhttp = New WinHttpRequest xmlhttp.Open "GET", URL$, True: DoEvents xmlhttp.Send: DoEvents If Not xmlhttp.WaitForResponse(TIMEOUT&) Then Debug.Print "timeout", URL: Exit Function End If GetResponse = xmlhttp.responsetext End Function

Sub test() ' пример использования On Error Resume Next txt = GetResponse("http://ExcelVBA.ru/") Debug.Print Len(txt) ' возвращает длину текста: 62737 символов End Sub

Ещё один пример функции — с возможностью задать кодировку:

Sub ТекстВебСтраницы_вКодировке_Windows1251() URL$ = "http://ExcelVBA.ru/" MsgBox GetHTTPResponse(URL$) ' MsgBox GetHTTPResponse(URL$, "windows-1251") ' если бы сайт выдавал страницу в windows-1251 End Sub

Function GetHTTPResponse(ByVal URL$, Optional ByVal Encoding$) As String On Error Resume Next Set oXMLHTTP = CreateObject("MSXML2.XMLHTTP") With oXMLHTTP .Open "GET", URL$, False .Send If Len(Encoding$) Then With CreateObject("ADODB.Stream") filename$ = Environ("tmp") & "\response.txt" .Charset = Encoding$: .Type = 1 ' adTypeBinary: .Open: .Write oXMLHTTP.ResponseBody .SaveToFile filename$, 2 .Type = 2 'adTypeText .LoadFromFile filename$ GetHTTPResponse = .ReadText .Close End With Else GetHTTPResponse = .ResponseText End If End With Set oXMLHTTP = Nothing End Function

‘ еще один вариант макроса для загрузки страницы

Sub test_internet() On Error Resume Next URL$ = "http://ExcelVBA.ru/" Const TIMEOUT& = 6 ' в секундах Set xmlhttp = CreateObject("WinHttp.WinHttpRequest.5.1") xmlhttp.Open "GET", URL$, True: DoEvents xmlhttp.Send: DoEvents If Not xmlhttp.WaitForResponse(TIMEOUT&) Then MsgBox "timeout", URL: Exit Sub End If txt$ = xmlhttp.responsetext MsgBox txt, vbInformation, "Длина ответа: " & Len(txt) End Sub

А эту заготовку кода я использовал, когда писал макросы для загрузки данных с сайтов
(последние несколько лет подобные макросы не пишу, ибо сделал универсальную надстройку «Парсер сайтов», в которой всё это реализуется 1-2 простейшими командами)

Sub LoadInfo() ' On Error Resume Next Dim ra As Range: Set ra = Range(Range("b2"), Range("b" & Rows.Count).End(xlUp)) If ra.Row = 1 Then MsgBox "На листе не найден список ИНН", vbCritical: Exit Sub Dim cell As Range, txt$, res$, result_cell As Range, v Const TIMEOUT& = 6: Static xmlhttp As Object If xmlhttp Is Nothing Then Set xmlhttp = CreateObject("WinHttp.WinHttpRequest.5.1") For Each cell In ra.Cells URL$ = "https://sbis.ru/contragents/" & Trim(cell) xmlhttp.Open "GET", URL$, True: DoEvents xmlhttp.Send: DoEvents If Not xmlhttp.WaitForResponse(TIMEOUT&) Then Debug.Print "timeout", URL Else txt$ = "": txt$ = xmlhttp.responsetext ' обработка ответа сервера ' функцию GetTags можно взять здесь: excelvba.ru/code/html res$ = "": res$ = GetTags(txt, "div", "class", "cCard__Content-Var", "config 1") res$ = Replace(res$, "%22", "'"): res$ = Replace(res$, """", "'") ' ищем в ответе нужные данные With cell.EntireRow .Cells(3) = Replace(GetValue(res$, "УставнойКапитал"), " ", "") .Cells(4) = GetValue(res$, "Статус") .Cells(5) = GetValue(res$, "ВыручкаСтатистика") .Cells(6) = GetValue(res$, "ПрибыльСтатистика") .Cells(7) = GetValue(res$, "Выручка") .Cells(8) = GetValue(res$, "Прибыль") .Cells(9) = GetValue(res$, "ЧисленностьСотрудников") End With End If Next cell End Sub

Источник