Страницы: 1
RSS
Макрос для проверки почтовых отправлений на сайте Почты России, Мониторинг по трек-номеру почтовых отправлений на сайте Почты России
 
Нужна ваша помощь в написании кода vba для проверки почтовых отправлений по трек-номеру на сайте Почты России на странице отслеживания https://www.pochta.ru/tracking. а именно из одного столбца брал трек-код и парсинговал информацию по последнему статусу.  (дата, время, место) и так по каждому трек-коду в данном столбце.

Ранее была такая темя в форуме но с 2011 года сайт значительно изменился и решение вопроса уже не актуально. (https://www.planetaexcel.ru/forum/?PAGE_NAME=read&FID=8&TID=26916)
Так в этом обсуждении был написан код возможно будет полезен для решения. (файл в приложении) Заранее огромное спасибо!
 
Ссылка под спойлером,метод post, отправляется barcodes=трекномер .
В ответ приходит сложный json.Разбираете его и будет всем счастье.
Скрытый текст
 
Спасибо, за помощь, но я к сожалению дилетант в этом деле, из Вашего сообщения ничего не понял.))  

Возможно этот код настроить под новый сайт Почты России:

Sub post()
   Dim oIE As Object, sHTML As String, tmp, i As Long, j As Long
   Application.ScreenUpdating = False
   Set oIE = CreateObject("InternetExplorer.Application")
   oIE.Visible = 0
   oIE.Navigate ("http://info.russianpost.ru/servlet/post_item")
   Do While oIE.busy Or (oIE.ReadyState <> 4): DoEvents: Loop
   For j = 6 To Cells(Rows.Count, 2).End(xlUp).Row
       oIE.Document.forms(0).elements("barCode").Value = Cells(j, 2).Value
       oIE.Document.forms(0).elements("barCodeSearchBtn").Click
       Do While oIE.busy Or (oIE.ReadyState <> 4): DoEvents: Loop
       sHTML = oIE.Document.body.innerhtml
       tmp = Split(sHTML, "<")
       For i = 0 To UBound(tmp)
           If InStr(tmp(i), "Приём") > 0 Then
               Cells(j, 3) = Format(Split(tmp(i + 2), ">")(1), "DD.MM.YYYY")
               Cells(j, 4) = Split((Split(tmp(i + 6), ">")(1)), " ")(0)
           End If
           If InStr(tmp(i), "Вручение") > 0 Then
               Cells(j, 5) = Format(Split(tmp(i + 2), ">")(1), "DD.MM.YYYY")
               Cells(j, 6) = Split(tmp(i + 4), ">")(1)
               Cells(j, 7) = Split(tmp(i + 10), ">")(1)
               Exit For
           End If
       Next
   Next
   Set oIE = Nothing
   Application.ScreenUpdating = True
End Sub
Изменено: ProAndrey - 14.10.2020 09:41:11
Страницы: 1
Наверх