Всем, привет. Есть сайт с таблицей, и 100400 страницами. Хочется его не спеша, "слить" в один Excel.
Нашел, простенький скриптик тут https://vc.ru/newtechaudit/118651-parsing-sayta-s-pomoshchyu-excel но его расместили в виде картинок... Может у кого то есть уже готовый такой, или аналогичный скриптик?.... Цель, собрать таблицы из 100500 страниц в одинe эксель табицу.
Перенабил буквицами :-) И конечно не работает , те кто с руками посмотрите, где надо докрутить. MiD пишет функция не предопределена
Код
Sub MyParser()
Set sp = ThisWorkbook.Sheets(1)
Set ww = CreateObject("InternetExplorer.Application")
ww.Visible = True
For i = 2 To 4
link = "http://&page=" & i ' Указываем ссылку на страчику
ww.navigate link
While ww.BUSY Or (ww.READYSTATE <> 4): DoEvents: Wend
getHTML = ww.document.body.innerHTML
dl = Len(getHTML)
a = InStr(na, getHTML, "tr class=")
If a > 0 Then
LR = sp.Cells(Rows.Count, 1).End(x1Up).Row
'Несколько манипуляций для вырезки необходимой информации
rn = InStr(a, getHTML, "<td>")
rk = InStr(rn, getHTML, "</td>")
rrn = Mid(getHTML, rn + 4, rk - rn - 4)
'Записываем результат в таблицу
sp.Cells(LR + 1, 1) = rrn ' реестровый номер адвоката
'Несколько манипуляций для вырезки необходимой информации
fn = InStr(rk, getHTML, "lawyers/show/")
fn = InStr(fn, getHTML, ">")
fk = InStr(fn, getHTML, "/a")
ffn = Mid(getHTМL, fn + 1, fk - fn - 1)
'Записываем результат в таблицу
sp.Ce11s(LR + 1, 2) = ffn 'ФИО адвоката
End If
Next
End Sub
Sub MyParser()
Set sp = ThisWorkbook.Sheets(1)
Set ww = CreateObject("InternetExplorer.Application")
ww.Visible = True
For i = 2 To 4
link = "http://&page=" & i ' Указываем ссылку на страчику
ww.navigate link
While ww.BUSY Or (ww.READYSTATE <> 4): DoEvents: Wend
getHTML = ww.document.body.innerHTML
dl = Len(getHTML)
a = InStr(na, getHTML, "tr class=")
If a > 0 Then
LR = sp.Cells(Rows.Count, 1).End(x1Up).Row
'Несколько манипуляций для вырезки необходимой информации
rn = InStr(a, getHTML, "<td>")
rk = InStr(rn, getHTML, "</td>")
rrn = Mid(getHTML, rn + 4, rk - rn - 4)
'Записываем результат в таблицу
sp.Cells(LR + 1, 1) = rrn ' реестровый номер адвоката
'Несколько манипуляций для вырезки необходимой информации
fn = InStr(rk, getHTML, "lawyers/show/")
fn = InStr(fn, getHTML, ">")
fk = InStr(fn, getHTML, "/a")
ffn = Mid(getHTМL, fn + 1, fk - fn - 1)
'Записываем результат в таблицу
sp.Ce11s(LR + 1, 2) = ffn 'ФИО адвоката
End If
Next
End Sub
Laa911, если мысль ворочалась медленнее, чем клацание мышкой, можно вернуться и дополнить предыдущее ообщение, а не множить очереди. Отредактируйте сообщение №7, нижние будут удалены