Страницы: 1
RSS
Как загнать значение с сайта в ячейку (vba)
 
Здравствуйте, не могу никак соскрапить значение с сайта в ячейку, мне известен css selector, но выдает различные ошибки.

Прошу помочь с решением данного вопроса.

Сайт: https://zakupki.gov.ru/epz/contract/contractCard/common-info.html?reestrNumber=2183104497918000748

Что нужно соскрапить: Дата заключения контракта - 30.10.2018 (только саму дату надо, без заголовка)

Селектор необходимого: ".container:nth-child(6) .section:nth-child(1) .section__info"

Код, который набросал:
Код
Sub pupa()
    Dim wb As Workbook
    Dim ws As Worksheet
    Dim TxtRng As Range
    Dim ie As Object
    Dim data As String, ipt As String, tblsheet As Worksheet, gtrpt As String, lastrow As Integer, i As Integer
    Set tblsheet = ThisWorkbook.Sheets("Òàáëèöà")
    lastrow = tblsheet.UsedRange.Rows.Count
    
For n = 2 To lastrow
    i = n
    ipt = tblsheet.Cells(n, 1)
    Set ie = CreateObject("INTERNETEXPLORER.APPLICATION")
With ie
    .Visible = True
    .Navigate "https://zakupki.gov.ru/epz/contract/contractCard/common-info.html?reestrNumber=" & ipt '
    Do Until .ReadyState = 4: DoEvents: Loop
    
    'tblsheet.Cells(i, 2) = ie.document.getelementbyid(".container:nth-child(6) .section:nth-child(1) .section__info")
    'tblsheet.Cells(i, 2) = ie.document.getelementbyclassname(".container:nth-child(6) .section:nth-child(1) .section__info")
    'tblsheet.Cells(i, 2) = ie.document.getelementbyid("body > div.cardWrapper.outerWrapper > div > div.contentTabBoxBlock.contractCard > div:nth-child(6) > div > div > div > section:nth-child(1) > span.section__info").innerHTML
    'Set getPrice = ie.document.getelementbyid("body > div.cardWrapper.outerWrapper > div > div.contentTabBoxBlock.contractCard > div:nth-child(6) > div > div > div > section:nth-child(1) > span.section__info")
    'Dim myValue As String: myValue = getPrice.innertext
    
    .Quit
    End With
    
    
    
Next

End Sub

Суть в том, что в столбец 1 загнаны номера контрактов, далее в столбец 2, например, надо вставить дату заключения контракта.
 
Код
Sub DataKontrakta()
Dim XMLHTTP As Object
Dim Myurl$, Txt$, DataKontr$
Dim n&, k&
Myurl = "https://zakupki.gov.ru/epz/contract/contractCard/common-info.html?reestrNumber=2183104497918000748"
Set XMLHTTP = CreateObject("MSXML2.XMLHTTP") 'или Microsoft.XMLHTTP
XMLHTTP.Open "GET", Myurl, False
XMLHTTP.send
If XMLHTTP.Status = 200 Then
    Txt = XMLHTTP.responseText
    n = InStr(1, Txt, "Дата заключения контракта")
    n = InStr(n, Txt, "<span class=""section__info"">") + 28
    k = InStr(n, Txt, "</span>")
    DataKontr = Mid(Txt, n, k - n)
    MsgBox DataKontr
Else
    MsgBox "Отсутствует соединение..."
End If
Set XMLHTTP = Nothing
End Sub
Мастерство программиста не в том, чтобы писать программы, работающие без ошибок.
А в том, чтобы писать программы, работающие при любом количестве ошибок.
 
Спасибо, работает!

Только вылетает значение в MsgBox, мне же необходимо загнать в ячейку.
Плюс мне не совсем понятен принцип того, как вы вырвали значение таким образом (например строка
Код
n = InStr(n, Txt, "<span class=""section__info"">") + 28
.что за +28, не понимаю, честно говоря)

Как, например, сделать аналогичное с ИНН в самом низу страницы?
Его идентификатор - ".section__info:nth-child(4)"

P. S. Я не слишком силен в VBA, отсюда и вопросы.
 
Есть замечание по первому коду, по строке
Код
lastrow = tblsheet.UsedRange.Rows.Count

когда-нибудь нарвётесь на то, что usedrange будет начинаться не с первой строки, и кстати последствия этой ошибки можете вообще и не заметить...
 
Код
lastrow = tblsheet.UsedRange.Rows.Count + tblsheet.UsedRange.Row - 1
 
UPD. Все разобрался, все сделал, как требуется, всем спасибо
Страницы: 1
Наверх