Пример вызова Подсказок DaData.ru из Excel

README.md

Пример вызова Подсказок DaData.ru из Excel

Как подключить пример

1. Откройте Excel и включите отображение вкладки «Разработчик»
2. Перейдите в редактор Visual Basic (в ленте Разработчик > Visual Basic).
3. Откройте список ссылок: в меню Tools > References...
4. Отметьте пункты «Microsoft Scripting Runtime» и «Microsoft VBScript Regular Expressions 5.5». Нажмите OK.
5. Скачайте архив с библиотекой VBA-JSON. Распакуйте его.
6. В меню File > Import file... выберите JsonConverter.bas из распакованного архива.
7. Откройте модуль Лист1.
8. Скопируйте код из примера в модуль.
9. Замените значение константы API_KEY с CHANGE_ME на ваш API-ключ.

Как работает пример

Введите название компании или ИНН в ячейку A1, нажмите «энтер». В соседних ячейках появятся реквизиты компании из Подсказок.

suggestions.cls

Private Const API_KEY = "CHANGE_ME"

Function Suggest(ByVal name, ByVal query, ByVal count) As Object
    Dim http
    Set http = CreateObject("WinHttp.WinHttpRequest.5.1")
    timeout = 2000 'milliseconds
    http.setTimeouts timeout, timeout, timeout, timeout
    request = "{ ""query"": """ & query & """, ""count"": """ & count & """ }"
    http.Open "POST", "https://suggestions.dadata.ru/suggestions/api/4_1/rs/suggest/" & name
    http.setRequestHeader "Content-Type", "application/json"
    http.setRequestHeader "Authorization", "Token " & API_KEY
    http.send request
    Debug.Print http.responseText
    Set Suggest = JsonConverter.ParseJson(http.responseText)
End Function

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim KeyCells As Range
    If Target.Address = "$A$1" Then
        Debug.Print "Source: " & Target.Value
        Dim Suggestions As Object
        Set Suggestions = Suggest("party", Target.Value, 1)
        Dim Company As Object
        Set Company = Suggestions("suggestions")(1)("data")
        Range("B1").Value = Company("name")("short_with_opf")
        Range("C1").Value = Company("ogrn")
        Range("D1").Value = Company("inn")
        Range("E1").Value = Company("kpp")
        Range("F1").Value = Company("okved")
        Range("G1").Value = Company("address")("data")("source")
    End If
End Sub

Не выходит достать данные со второго уровня данных. что делать???

Помогите, плз. Делаю всё по инструкции, ловлю ошибку (скрин). При нажатии Debug указывает на конкретное поле (скрин


)

Ошибка в TLS данной конкретной версии винды. Решения найдено не было. Лечится только заменой версии винды. Рекомендую 10 LTSC. чт, 16 нояб. 2023 г., 20:31 Voytos1989 ***@***.***>:

…

***@***.**** commented on this gist. ------------------------------ Помогите, плз. Делаю всё по инструкции, ловлю ошибку (скрин). При нажатии Debug указывает на конкретное поле (скрин [image: 2023-11-16_19-28-38] <https://user-images.githubusercontent.com/151059398/283525152-6c2effe7-c5c8-4bd1-9696-8805774a6dc9.png> [image: 2023-11-16_19-28-51] <https://user-images.githubusercontent.com/151059398/283525208-fb6b9730-6ba9-4df9-80bc-61fa6b2801c6.png> ) — Reply to this email directly, view it on GitHub <https://gist.github.com/nalgeon/b5d0c7b72bb6b393475ae67e73c86ed3#gistcomment-4762754> or unsubscribe <https://github.com/notifications/unsubscribe-auth/AF72YZUJXLD3YGJWWETDF6DYEY5UPBFKMF2HI4TJMJ2XIZLTSKBKK5TBNR2WLJDHNFZXJJDOMFWWLK3UNBZGKYLEL52HS4DFQKSXMYLMOVS2I5DSOVS2I3TBNVS3W5DIOJSWCZC7OBQXE5DJMNUXAYLOORPWCY3UNF3GS5DZVRZXKYTKMVRXIX3UPFYGLK2HNFZXIQ3PNVWWK3TUUZ2G64DJMNZZDAVEOR4XAZNEM5UXG5FFOZQWY5LFVA2DKOBXHA4TGONHORZGSZ3HMVZKMY3SMVQXIZI> . You are receiving this email because you commented on the thread. Triage notifications on the go with GitHub Mobile for iOS <https://apps.apple.com/app/apple-store/id1477376905?ct=notification-email&mt=8&pt=524675> or Android <https://play.google.com/store/apps/details?id=com.github.android&referrer=utm_campaign%3Dnotification-email%26utm_medium%3Demail%26utm_source%3Dgithub> .

Может кому пригодиться.
Делал генератор документов по шаблону, и простую интеграция с DaData, растянуто на все столбцы.
В ячейке D2 вводим ИНН. Получаем подсказки в ячейках G, H, I, J (название компании, юр.адрес, код ОКПО, ФИО директора).
Внимание, не кретичная ошибка в ячейке ФИО директора, если это ИП, а не ООО.

Private Const API_KEY = "Ваш API"

Function Suggest(ByVal name, ByVal query, ByVal count) As Object
    Dim http
    Set http = CreateObject("WinHttp.WinHttpRequest.5.1")
    timeout = 2000 'milliseconds
    http.setTimeouts timeout, timeout, timeout, timeout
    request = "{ ""query"": """ & query & """, ""count"": """ & count & """ }"
    http.Open "POST", "https://suggestions.dadata.ru/suggestions/api/4_1/rs/suggest/" & name
    http.setRequestHeader "Content-Type", "application/json"
    http.setRequestHeader "Authorization", "Token " & API_KEY
    http.send request
    Debug.Print http.responseText
    Set Suggest = JsonConverter.ParseJson(http.responseText)
End Function

Private Sub Worksheet_Change(ByVal Target As Range)
  Dim KeyCells As Range
  If Target.Column <> 4 Then Exit Sub
  If Target.Row = 1 Then Exit Sub
  If IsEmpty(Target) Then Target.Offset(0, 3).Resize(1, 4) = Empty: Exit Sub
  Debug.Print "Source: " & Target.Value
  Dim Suggestions As Object
  Set Suggestions = Suggest("party", Target.Value, 1)
  Dim Company As Object
  Set Company = Suggestions("suggestions")(1)("data")
  Target.Offset(0, 3) = Company("name")("short_with_opf")
  Target.Offset(0, 4) = Company("address")("unrestricted_value")
  Target.Offset(0, 5) = Company("okpo")
  Target.Offset(0, 6) = Company("management")("name")
End Sub