получается идет изменение в номере -9023&, отсюда вопросы как получить все номера тиражей со страницы? и сделать так чтобы данные записывались в строчку горизонтально как на странице итог
Sub test2()
Dim url, ss, p, u, i, tir, j, ri
Dim t, El, StrArr() As String, s1, s2
Dim htm
Set htm = CreateObject("htmlfile")
For j = 9026 To 1 Step -1
s1 = "": s2 = ""
url = "http://www.marathontotoservice.com/sttot/pbstyle/SttotTime.aspx?id=-" & j & "&GMT=+3"
ss = GetHTTPResponse_P(url)
If InStr(1, ss, "Тираж №") > 0 Then
tir = Split(Split(ss, "Тираж №")(1), ",")(0)
htm.body.innerhtml = ss
For Each El In htm.getElementsByTagName("TR")
If InStr(1, El.innerhtml, "TEXT-ALIGN") > 0 Then
If InStr(1, El.innerhtml, ">Дата<") = 0 Then
u = Split(El.innerhtml, vbCrLf)
t = Split(Split(u(1), ">")(1), "<")(0)
s1 = IIf(Len(s1) = 0, t, s1 & "," & t)
t = Split(Split(u(3), ">")(1), "<")(0)
s2 = IIf(Len(s2) = 0, t, s2 & "," & t)
End If
End If
Next El
ri = ri + 1
Cells(ri, 1) = "Тираж №" & tir
Cells(ri, 2).Resize(, 15) = Split(s1, ",")
Cells(ri, 18).Resize(, 15) = Split(s2, ",")
Cells(ri, 35) = j
End If
DoEvents
Next j
End Sub
Private Function GetHTTPResponse_P(ByVal sURL As String) As String
Dim oXMLHTTP
On Error Resume Next
Set oXMLHTTP = CreateObject("MSXML2.XMLHTTP")
With oXMLHTTP
.Open "GET", sURL, False
.send
GetHTTPResponse_P = .responseText
End With
Set oXMLHTTP = Nothing
End Function
Добрый день, скажите пожалуйста можно как то добавить в парсер чтобы он парсел не все по новой, а только новые данные вносил вверху странице, к примеру сейчас у меня есть данные от 04.05.2022 мне нужно добавить два дня, 05.06.2022 и 07.05.2022.
Код
Sub test2()
Dim url, ss, p, u, i, tir, j, ri
Dim t, El, StrArr() As String, s1, s2
Dim htm
ri = 1
Start = 0
Set htm = CreateObject("htmlfile")
For j = 9134 To 1 Step -1
s1 = "": s2 = ""
url = "http://www.marathontotoservice.com/sttot/pbstyle/SttotTime.aspx?id=-" & j & "&GMT=+3"
ss = GetHTTPResponse_P(url)
If InStr(1, ss, "Тираж №") > 0 Then
tir = Split(Split(ss, "Тираж №")(1), ",")(0)
htm.body.innerhtml = ss
p = 0
For Each El In htm.getElementsByTagName("TR")
If p > 0 Or Start = 0 Then
For i = 0 To El.Cells.Length - 1
If El.Cells(i).innertext = "" Then ri = ri - 1: Exit For
Cells(ri, i + 1) = El.Cells(i).innertext
Next
ri = ri + 1
End If
p = p + 1
Next El
Start = 1
End If
DoEvents
Next j
End Sub
Private Function GetHTTPResponse_P(ByVal sURL As String) As String
Dim oXMLHTTP
On Error Resume Next
Set oXMLHTTP = CreateObject("MSXML2.XMLHTTP")
With oXMLHTTP
.Open "GET", sURL, False
.send
GetHTTPResponse_P = .responseText
End With
Set oXMLHTTP = Nothing
End Function