Здравствуйте! Так в чем проблема? Если нужно найти, то вбиваете название организации на указанный сайт и ищете
Скрытый текст
Проверки на множественные ИНН нет (можно сделать), если вбить в поиск чепуху, то сайт выдаст несколько ИНН и парсер выберет первый.
Код
Function PoiskINN(s As String)
'aequit 27.02.2020
Dim URL As String, strTxt As String
Dim XMLHTTP
s = Application.WorksheetFunction.Trim(s)
s = Replace(s, " ", "+")
URL$ = "https://www.list-org.com/search?type=all&val=" & s
Const TIMEOUT& = 15
Set XMLHTTP = CreateObject("WinHttp.WinHttpRequest.5.1")
XMLHTTP.Open "GET", URL$, True: DoEvents
XMLHTTP.send: DoEvents
If Not XMLHTTP.WaitForResponse(TIMEOUT&) Then
MsgBox "Сайт не найден! (timeout)", URL: Exit Function
End If
strTxt = XMLHTTP.responseText
PoiskINN = RegExPRepl(strTxt, "([\s\S]*>инн</i>: ?)(\d{10,12})([\s\S]*)", "$2")
End Function
Function RegExPRepl(sString$, sFind$, sReplace$, Optional bGlobal As Boolean = True, _
Optional bMultiLine As Boolean = True, Optional bIgnoreCase As Boolean = True) As String
Static RegEx As RegExp
If RegEx Is Nothing Then Set RegEx = New RegExp
With RegEx
.Global = bGlobal
.MultiLine = bMultiLine
.IgnoreCase = bIgnoreCase
.Pattern = sFind
End With
RegExPRepl = RegEx.Replace(sString, sReplace)
End Function
Добавил несколько усовершенствованный вариант, с некоторой защитой от выдачи неоднозначного результата.
Скрытый текст
Код
Function PoiskINN(s As String)
'aequit 28.02.2020
Dim URL As String, strTxt As String
Dim XMLHTTP
s = Application.WorksheetFunction.Trim(s)
s = Replace(s, " ", "+")
URL$ = "https://www.list-org.com/search?type=all&val=" & s
Const TIMEOUT& = 15
Set XMLHTTP = CreateObject("WinHttp.WinHttpRequest.5.1")
XMLHTTP.Open "GET", URL$, True: DoEvents
XMLHTTP.send: DoEvents
If Not XMLHTTP.WaitForResponse(TIMEOUT&) Then
MsgBox "Сайт не найден! (timeout)", URL: Exit Function
End If
strTxt = XMLHTTP.responseText
PoiskINN = RegExPRepl(strTxt)
End Function
Function RegExPRepl(sString$) As String
'aequit 28.02.2020
Static RegEx As RegExp
Dim objMatches As MatchCollection
If RegEx Is Nothing Then Set RegEx = New RegExp
With RegEx
.Global = True
.MultiLine = True
.IgnoreCase = True
.Pattern = "(?:>инн</i>: ?)(\d{10,12})"
End With
If Not RegEx.Test(sString) Then
RegExPRepl = "ИНН не обнаружен!"
Exit Function
End If
Set objMatches = RegEx.Execute(sString)
If objMatches.Count > 1 Then
RegExPRepl = "Обнаружено более одного ИНН! Уточните наименование организации!"
Exit Function
End If
RegExPRepl = RegEx.Execute(sString)(0).SubMatches.Item(0)
End Function
Допустим, нет макроса и программы. Например, вводите неточный запрос Сайт отдаёт более одной организации. Макрос определяет или один ИНН (тогда выводится результат), или их больше одного (выводится сообщение об этом). Что именно выводить в ответ на запрос - на стороне сайта.
Function PoiskOrg(s As String)
Dim oHttp As Object
Dim strURL As String
strURL = "https://www.list-org.com/search?type=inn&val=" & s
On Error Resume Next
Set oHttp = CreateObject("MSXML2.XMLHTTP")
If Err.Number <> 0 Then
Set oHttp = CreateObject("MSXML.XMLHTTPRequest")
End If
On Error GoTo 0
If oHttp Is Nothing Then
MsgBox "Не удалось инициализировать объект MSXML!"
Exit Function
End If
oHttp.Open "GET", strURL, False
oHttp.Send
PoiskOrg = RegExPRepl(oHttp.ResponseText)
Set oHttp = Nothing
End Function
Function RegExPRepl(sString$) As String
'aequit 24.12.2020
Static RegEx As RegExp
Dim objMatches As MatchCollection
If RegEx Is Nothing Then Set RegEx = New RegExp
With RegEx
.Global = True
.MultiLine = True
.IgnoreCase = True
.Pattern = "(<br><span>)([\S\s]*?)(<br><i>инн</i>:)"
End With
If Not RegEx.test(sString) Then
RegExPRepl = "Организация не обнаружена!"
Exit Function
End If
Set objMatches = RegEx.Execute(sString)
If objMatches.Count > 1 Then
RegExPRepl = "Обнаружено более одной организации! Уточните ИНН!"
Exit Function
End If
RegExPRepl = RegEx.Execute(sString)(0).SubMatches.Item(1)
End Function
sabotajue, вам лучше спросить у aequit. Это его код. Я лишь переделал его код в функцию, которая должна по названию компании выдавать 1 ИНН (показывать 1 ИНН в ячейке).
P.S. Или вы имеете ввиду, что макрос находит ИНН только для 13-ти компаний, а для большего числа не находит? Возможно на сайте, к которому обращается макрос (путь к сайту прописан в макросе) стоит защита и не выдаёт больше результатов для 1 IP адреса. (то есть с 1 компьютера можно сделать только 13 запросов). Но это лишь мои предположения.
sabotajue написал: а сейчас появляется либо #ЗНАЧ! либо 0 появляется в столбце ИНН
Посмотрел Ваш файл. Вероятно, Вы делали слишком много запросов. Сработала защита сайта. При попытке сделать запрос напрямую с сайта, без макроса и вообще без Excel получил сообщение "Вы слишком часто обращались к сайту и мы хотим убедиться, что вы не робот. Повторите русские прописные буквы с картинки и сможете дальше работать".