Excel макрос vba парсинг реквизитов организации инн - Word и Excel

Здравствуйте.
Пожалуйста, помогите написать макрос для сбора информации с сайта ИФНС о контрагенте.
Есть файл с наименованием контрагента и его ИНН в отдельных столбцах.
Макрос должен спросить с какой ячейки просматривать ИНН и в какой столбец записывать результат запроса информации с сайта ИФНС.
Если ИНН в таблице отсутствует, заполнять результат сообщением «ИНН не указан», если ИНН например 000000000000 (сообщение на сайте «По заданным критериям поиска данных не найдено.» можно и прошлый случай также заполнять).

Сайт ИФНС https://egrul.nalog.ru/index.html

Нечто подобное реализовано в рамках работы https://www.planetaexcel.ru/fo… &TID=65215

Источник

QASDER

Пользователь

Сообщений: 1
Регистрация: 27.02.2020

Добрый день, не нашел данного парсера. Что нужно? есть список организаций. Например:

Муниципальное общеобразовательное бюджетное учреждение «Средняя общеобразовательная школа с. Аркадьевка»

Муниципальное общеобразовательное автономное учреждение средняя общеобразовательная школа №1 с.Возжаевки

Муниципальное общеобразовательное автономное учреждение средняя общеобразовательная школа с.Пригородного

Нужно найти их ИНН на сайте list-org.com или другом

Изменено: vikttur — 18.07.2021 23:14:34

aequit

Пользователь

Сообщений: 209
Регистрация: 13.01.2020

27.02.2020 20:07:08

Цитата
QASDER написал: Нужно найти их

Здравствуйте!
Так в чем проблема? Если нужно найти, то вбиваете название организации на указанный сайт и ищете

Скрытый текст

Прикрепленные файлы

ПарсерИНН.xlsm (19.5 КБ)

aequit

Пользователь

Сообщений: 209
Регистрация: 13.01.2020

28.02.2020 08:35:32

Добавил несколько усовершенствованный вариант, с некоторой защитой от выдачи неоднозначного результата.

Скрытый текст

Прикрепленные файлы

ПарсерИНН_v2.xlsm (20.11 КБ)

sabotajue Пользователь Сообщений: 154 Регистрация: 27.05.2013	А как бы сделать всё тоже самое только списком и проставлять найденную информацию рядом

New Пользователь Сообщений: 4581 Регистрация: 06.01.2013	Чуть переделал файл от aequit

Тимофеев Пользователь Сообщений: 1495 Регистрация: 01.09.2020	а ОКПО зацепить оттуда можно?

aequit Пользователь Сообщений: 209 Регистрация: 13.01.2020	Именно этот сайт не отдаёт ОКПО в результатах запроса. Соответственно, в XMLHTTP.responseText сведений про ОКПО нет.

Тимофеев Пользователь Сообщений: 1495 Регистрация: 01.09.2020	а если более одного ИНН находит чем уточнять тогда в названии?

aequit

Пользователь

Сообщений: 209
Регистрация: 13.01.2020

Допустим, нет макроса и программы.
Например, вводите

неточный запрос

Сайт отдаёт более одной организации. Макрос определяет или один ИНН (тогда выводится результат), или их больше одного (выводится сообщение об этом). Что именно выводить в ответ на запрос — на стороне сайта.

kalle Пользователь Сообщений: 120 Регистрация: 01.01.1970	А что нужно поменять в коде функций, чтобы парсер работал «наоборот»: по ИНН (или ОГРН) выдавал название и адрес организации?

aequit

Пользователь

Сообщений: 209
Регистрация: 13.01.2020

#11

24.12.2020 08:20:17

Примерно так:

Скрытый текст

P.s. Паттерн для адреса, если кому нужно:

Код
.Pattern = "(<i>адрес</i>: )([Ss]*?)(</span></label></p>)"

Прикрепленные файлы

ПарсерОрганизацииПоИНН_v3.xlsm (20.31 КБ)

kalle Пользователь Сообщений: 120 Регистрация: 01.01.1970

sabotajue

Пользователь

Сообщений: 154
Регистрация: 27.05.2013

#13

25.12.2020 11:06:05

Цитата
New написал: Чуть переделал файл от aequit

выдает только 13 результатов

New

Пользователь

Сообщений: 4581
Регистрация: 06.01.2013

sabotajue, вам лучше спросить у

aequit

. Это его код. Я лишь переделал его код в функцию, которая должна по названию компании выдавать 1 ИНН (показывать 1 ИНН в ячейке).

P.S. Или вы имеете ввиду, что макрос находит ИНН только для 13-ти компаний, а для большего числа не находит? Возможно на сайте, к которому обращается макрос (путь к сайту прописан в макросе) стоит защита и не выдаёт больше результатов для 1 IP адреса. (то есть с 1 компьютера можно сделать только 13 запросов). Но это лишь мои предположения.

sabotajue Пользователь Сообщений: 154 Регистрация: 27.05.2013	Я протянул функцию, но после добавления 158 названий у меня закрывается excel

New Пользователь Сообщений: 4581 Регистрация: 06.01.2013	а ранее вы писали про 13 результатов, сейчас про 158. А сколько в вашем файле компаний? Можете выложить файл?

sabotajue Пользователь Сообщений: 154 Регистрация: 27.05.2013

sabotajue Пользователь Сообщений: 154 Регистрация: 27.05.2013	а сейчас появлется либо #ЗНАЧ! либо 0 появлется в столбце ИНН

New Пользователь Сообщений: 4581 Регистрация: 06.01.2013	У меня вообще перестал этот сайт открываться, пишет: Не удается получить доступ к сайту Превышено время ожидания ответа от сайта www.list-org.com .

aequit

Пользователь

Сообщений: 209
Регистрация: 13.01.2020

#20

25.12.2020 13:22:43

Цитата
sabotajue написал: а сейчас появляется либо #ЗНАЧ! либо 0 появляется в столбце ИНН

Посмотрел Ваш файл. Вероятно, Вы делали слишком много запросов. Сработала защита сайта.
При попытке сделать запрос напрямую с сайта, без макроса и вообще без Excel
получил сообщение «Вы слишком часто обращались к сайту и мы хотим убедиться, что вы не робот.
Повторите русские прописные буквы с картинки и сможете дальше работать».

Павел Иванов Пользователь Сообщений: 11 Регистрация: 12.06.2020	#21 18.07.2021 20:34:17 Добрый день, подскажите пожалуйста, сейчас парсер не работает, ввожу названия компаний, везде пишет ИНН не обнаружен.

Источник

Задача:

Имея в наличии список ИНН организаций, выявить «мутные» организации (директора и учредители которых имеют еще множество других фирм)
Поиск данных об организациях выполняется в реестре портала Контур.Фокус
Выводятся следующие данные: название организации, КПП, ОРГН, ОКПО, виды деятельности (основной и дополнительные), сведения об учредителе и руководителе (ИНН, ФИО, должность, количество связей), дата образования и адрес, а также подробная информация об обнаруженных связях (задолженности, исполнительные производства, проблемы с ФНС и судами, и т.п.)

Описание:

Для работы парсера необходимо иметь платную подписку на доступ к поиску по сайту focus.kontur.ru
(ну или каждый день получать бесплатные 24 часа доступа к сервису, с нового номера мобильного телефона)
Перед запуском парсера, необходимо авторизоваться в браузере Internet Explorer (программа использует его для запроса сведений).

Парсер берет ИНН контрагента из первого столбца таблицы, и выполняет запрос по адресу https://focus.kontur.ru/search?query=ИНН
(также позможен поиск по ОКПО, ОГРН или названию организации)
Данные со страницы организации берутся со вкладок Сводка и Связи.

На вкладке Связи присутствует список потенциально связанных организаций (на нескольких страницах),
откуда парсер берет данные для вывода информации о связях (по каждому исходному ИНН дополнительно создаётся отдельный лист со списком связанных фирм)

Изначально в таблице Excel присутствует только один лист, и заполнен только первый столбец
(один или несколько ИНН для проверки, в первом столбце, начиная со второй строки)
После запуска парсера, создаются и заполняются все остальные столбцы, и создаются дополнительные листы.

Парсер собирает данные из реестра сравнительно быстро, — на 1 организацию уходит порядка 3 секунд.
Таким образом, спустя минуту-другую, вы видите в таблице полный расклад по контрагентам, и делаете выводы, с кем стоит работать, а с кем лучше не иметь никаких дел.

Практически все данные в таблице снабжены гиперссылками, — всегда можно одним кликом получить на сайте более подробную информацию.

По вопросам приобретения настроек парсера, обращайтесь в скайп или на почту

Источник

Покажите в каком макросе это делается.
Я вижу в модуле 1 два «макроса» — процедуру CheckPartners() и функцию GetContrInfo(dDate As Date, sINN As String, sKPP As String)
Если вы хоть немного понимаете в vba, то сразу увидите, что функция получает ИНН и КПП при вызове. Вызывается она из процедуры, в процедуре последовательно считывается 98 ячеек листа
[vba]

Код

     For li = 2 To 100 Step 1
         ‘ Передаём параметры в UDF GetContrInfo
         Cells(li, 4) = GetContrInfo(Cells(li, 3).Value, Cells(li, 1).Value, Cells(li, 2).Value)

‘ Прогоняем статус (код) для получения статус (текст)
tmp = Cells(li, 4).Value

[/vba]

откуда берутся данные в ячейках, я не нашёл, думаю что вручную введены. Если очистить столбцы, то при выполнении макроса выдаёт сообщение об ошибке, т.е. ИНН и КПП из ниоткуда не берутся.

Источник

Option Explicit
 ' http://zakupki.gov.ru/epz/contract/contractCard/common-info.html?reestrNumber=3230907045518000019
Public Sub Проход_Выделенное()
' https://inexsu.wordpress.com/2018/09/15/%D0%BF%D0%B0%D1%80%D1%81%D0%B5%D1%80-%D0%B8%D0%B7%D0%B2%D0%BB%D0%B5%D0%BA%D0%B0%D1%82%D1%8C-%D1%82%D0%B5%D0%BA%D1%81%D1%82%D1%8B-%D1%81%D0%BE-%D1%81%D1%82%D1%80%D0%B0%D0%BD%D0%B8%D1%86/
Dim el As Range
    For Each el In Selection
        el.Value = String_From_HTTP_responseText_beTween( _
                   URL(el), _
                   string_Left, _
                   string_Right)
    Next
End Sub
 
Private Function URL(ByVal el As Range) As Variant
    On Error Resume Next
    URL = el.Offset(0, -13).Value
End Function
 
Private Function string_Left(Optional ByVal msg As Variant) As String
    string_Left = "<td>ИНН:</td>" & vbLf & "                            <td>"
End Function
 
Private Function string_Right(Optional ByVal msg As Variant) As String
    string_Right = "</td>" & vbLf & "                        </tr>" & vbLf & "                        " & vbLf & "" & vbLf & "                        <tr>"
End Function
 
Private Function String_From_HTTP_responseText_beTween( _
        ByVal str As String, _
        ByVal sLeft As String, _
        ByVal sRight As String) As String
 
    String_From_HTTP_responseText_beTween = extractBetween( _
                                            HTTP_getText(str), sLeft, sRight)
End Function
 
Private Function HTTP_getText(ByRef URL As String) As String
    With CreateObject("MSXML2.XMLHTTP")
        .Open "GET", URL, False
        .Send Null
        HTTP_getText = .responseText
    End With
    ' Copy2ClipBoard HTTP_getText '===для Отладки, потом У далить
End Function
 
Private Function extractBetween(ByVal txt As String, _
                                ByVal sLeft As String, _
                                ByVal sRight As String)
    If txt <> vbNullString And sLeft <> vbNullString And sRight <> vbNullString And _
       InStr(txt, sLeft) > 0 And InStr(txt, sRight) > 0 Then
        Dim s() As String
        s = Split(txt, sLeft)
        s = Split(s(1), sRight)
        extractBetween = s(0)
    Else
        If bDebug Then _
           Err.Raise 567, "Или пустые строки. Или нечего делить", "extractBetween"
    End If
End Function

Ещё есть парсер реквизитов организаций — ИНН, ОГРН и т.д. т.п.

Источник