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

README.md

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

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

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

@meziniakov Скажите как связяться, я могу Вам выслать

Аналогичный вопрос, можно ли пример того, как обработать диапазон ячеек?

Добрый день. Спасибо nalgeon за код. Для обработки ИНН в столбце А последовательно для каждого ряда мне помогла замена строк 104-117 на:

Function ExtractPostalCode(suggestion) As String
    ExtractPostalCode = Extract("postal_code", suggestion)
End Function
Function ExtractLongitude(suggestion) As String
    ExtractLongitude = Extract("geo_lon", suggestion)
End Function
Function ExtractLatitude(suggestion) As String
    ExtractLatitude = Extract("geo_lat", suggestion)
End Function
Private Sub Worksheet_Change(ByVal Target As Range)
     If Target.Column = 1 Then
        ThisRow = Target.Row
        If Target.Value = Range("A" & ThisRow).Value Then
            Debug.Print "Source: " & Target.Value
            suggested = Suggest("party", Target.Value, 1)
            'Debug.Print "Suggested: " & suggested
            Range("B" & ThisRow).Value = ExtractName(suggested)
            Range("C" & ThisRow).Value = ExtractOGRN(suggested)
            Range("D" & ThisRow).Value = ExtractINN(suggested)
            Range("E" & ThisRow).Value = ExtractKPP(suggested)
            Range("F" & ThisRow).Value = ExtractOKVED(suggested)
            Range("G" & ThisRow).Value = ExtractAddress(suggested)
            Range("H" & ThisRow).Value = ExtractPostalCode(suggested)
            Range("I" & ThisRow).Value = ExtractLongitude(suggested)
            Range("J" & ThisRow).Value = ExtractLatitude(suggested)
         End If
      End If
End Sub

Мне необходимо было на сайте клиента сделать Яндекс карту с метками продаж. Для этих целей понадобились долгота и широта адреса организации: Function ExtractLongitude и Function ExtractLatitude.
Соответственно убирайте/закомментируйте лишние столбцы с данными, если они вам не нужны.

Буду благодарна, если кто-то поделится кодом, который позволит единовременно добавлять несколько ИНН в столбец А.

@bplight добрый день могу прислать файл с примером, здесь код так не выложишь, т.к. код в трех местах: на сранице, в модуле и в классе.

@bplight добрый день могу прислать файл с примером, здесь код так не выложишь, т.к. код в трех местах: на сранице, в модуле и в классе.

А нельзя тут выложить все части кода с указанием мест?

не получается, создал проект: https://github.com/perceff/JasonForExcel

или выложил на upload ресурс: http://www.unibytes.com/4-q0c-UNQO-Lqw-Us4P3UgBB

не получается, создал проект: https://github.com/perceff/JasonForExcel

Спасибо!

День добрый! Подскажите, как в этом примере получить поля
opf.short и name.full

Спасибо!

@nalgeon День добрый! Подскажите пожалуйста как код адаптировать для формы access.

@perceff @nalgeon а можно вывести дату присвоения ОГРНИП? Если да то как, заранее спасибо
И если можно добавить в этом коде? https://github.com/perceff/JasonForExcel

Может кому полезно будет посмотреть, как выглядит типичный ответ на запрос:

{
  "suggestions": [
    {
      "value": "ООО ХЛЕБОРОБ",
      "unrestricted_value": "ООО ХЛЕБОРОБ",
      "data": {
        "kpp": "644901001",
        "capital": null,
        "management": {
          "name": "Федоров Владимир Михайлович",
          "post": "ДИРЕКТОР",
          "disqualified": null
        },
        "founders": null,
        "managers": null,
        "branch_type": "MAIN",
        "branch_count": 0,
        "source": null,
        "qc": null,
        "hid": "5581e9e02ce11f9995c34ba8dcbc524144ba6c6ce7243043715117fb36c2116e",
        "type": "LEGAL",
        "state": {
          "status": "ACTIVE",
          "actuality_date": 1546300800000,
          "registration_date": 855619200000,
          "liquidation_date": null
        },
        "opf": {
          "type": "2014",
          "code": "12300",
          "full": "Общество с ограниченной ответственностью",
          "short": "ООО"
        },
        "name": {
          "full_with_opf": "ОБЩЕСТВО С ОГРАНИЧЕННОЙ ОТВЕТСТВЕННОСТЬЮ ХЛЕБОРОБ",
          "short_with_opf": "ООО ХЛЕБОРОБ",
          "latin": null,
          "full": "ХЛЕБОРОБ",
          "short": "ХЛЕБОРОБ"
        },
        "inn": "6404002815",
        "ogrn": "1026400555675",
        "okpo": null,
        "okved": "46.21.11",
        "okveds": null,
        "authorities": null,
        "documents": null,
        "licenses": null,
        "finance": {
          "tax_system": null,
          "income": null,
          "expense": null,
          "debt": null,
          "penalty": null
        },
        "address": {
          "value": "Саратовская обл, г Энгельс, ул Марины Расковой, д 4",
          "unrestricted_value": "413121, Саратовская обл, г Энгельс, ул Марины Расковой, д 4",
          "data": {
            "postal_code": "413121",
            "country": "Россия",
            "country_iso_code": null,
            "federal_district": null,
            "region_fias_id": "df594e0e-a935-4664-9d26-0bae13f904fe",
            "region_kladr_id": "6400000000000",
            "region_iso_code": null,
            "region_with_type": "Саратовская обл",
            "region_type": "обл",
            "region_type_full": "область",
            "region": "Саратовская",
            "area_fias_id": null,
            "area_kladr_id": null,
            "area_with_type": null,
            "area_type": null,
            "area_type_full": null,
            "area": null,
            "city_fias_id": "c58d0505-54eb-4c34-8216-b14f7cdb0ecb",
            "city_kladr_id": "6400001300000",
            "city_with_type": "г Энгельс",
            "city_type": "г",
            "city_type_full": "город",
            "city": "Энгельс",
            "city_area": null,
            "city_district_fias_id": null,
            "city_district_kladr_id": null,
            "city_district_with_type": null,
            "city_district_type": null,
            "city_district_type_full": null,
            "city_district": null,
            "settlement_fias_id": null,
            "settlement_kladr_id": null,
            "settlement_with_type": null,
            "settlement_type": null,
            "settlement_type_full": null,
            "settlement": null,
            "street_fias_id": "9b203331-73b8-4141-8c16-8d56aa021976",
            "street_kladr_id": "64000013000023400",
            "street_with_type": "ул Марины Расковой",
            "street_type": "ул",
            "street_type_full": "улица",
            "street": "Марины Расковой",
            "house_fias_id": "c7ad9d3c-6fca-40f6-acc4-8bf2eb09f0ef",
            "house_kladr_id": "6400001300002340096",
            "house_type": "д",
            "house_type_full": "дом",
            "house": "4",
            "block_type": null,
            "block_type_full": null,
            "block": null,
            "flat_type": null,
            "flat_type_full": null,
            "flat": null,
            "flat_area": "429.0",
            "square_meter_price": "29032",
            "flat_price": "12454728",
            "postal_box": null,
            "fias_id": "c7ad9d3c-6fca-40f6-acc4-8bf2eb09f0ef",
            "fias_code": "64000013000000002340096",
            "fias_level": "8",
            "fias_actuality_state": "0",
            "kladr_id": "6400001300002340096",
            "geoname_id": null,
            "capital_marker": "0",
            "okato": "63450000000",
            "oktmo": "63650101001",
            "tax_office": "6449",
            "tax_office_legal": "6449",
            "timezone": "UTC+4",
            "geo_lat": "51.4807044",
            "geo_lon": "46.1396026",
            "beltway_hit": null,
            "beltway_distance": null,
            "metro": null,
            "qc_geo": "0",
            "qc_complete": null,
            "qc_house": null,
            "history_values": null,
            "unparsed_parts": null,
            "source": "413113, ОБЛАСТЬ САРАТОВСКАЯ, ГОРОД ЭНГЕЛЬС, УЛИЦА МАРИНЫ РАСКОВОЙ, ДОМ 4",
            "qc": "0"
          }
        },
        "phones": null,
        "emails": null,
        "ogrn_date": 1041292800000,
        "okved_type": "2014",
        "employee_count": null
      }
    }
  ]
}

хотел применить код к базе банков по бик . Не получается что не так?

мой код
Private Const API_KEY = "------------------------------"

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/bank" & 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")
Range("C1").Value = Company("correspondent_account")

        Range("d1").Value = Company("bic")
        
        'Range("q1").Value = Company("state")("status")
        'Range("r1").Value = Company("type")


End If

End Sub

Привет! Ну ты додумался 2-го января писать! Я в некондиции до 9-го ;-) Высылаю тебе рабочий прототип, покопайся пока в нем, копирайта нет, т.к. все это безнадежно устарело 1-го января. Если есть какие вопросы, то пиши 9-го. А по ошибке: переменная или свойство имеет неверный тип. Например, переменная целого типа, не может принимать строковые значения, которые не распознаются как целые числа Открой дебаггер и посмотри типы переменных или пришли мне сам файл, я посмотрю, у меня чет не правильно копируется в проект. чт, 2 янв. 2020 г. в 11:14, sergslip <notifications@github.com>:

…

хотел применить код к базе банков по бик . Не получается что не так? [image: Screenshot_2] <https://user-images.githubusercontent.com/59432455/71655561-3e4a7000-2d2f-11ea-85d5-2645068374b1.jpg> мой код Private Const API_KEY = "------------------------------" 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/bank" & 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") Range("C1").Value = Company("correspondent_account") Range("d1").Value = Company("bic") 'Range("q1").Value = Company("state")("status") 'Range("r1").Value = Company("type") End If End Sub — You are receiving this because you commented. Reply to this email directly, view it on GitHub <https://gist.github.com/b5d0c7b72bb6b393475ae67e73c86ed3?email_source=notifications&email_token=AF72YZWAMDXPMDJ63CIZY4TQ3WH63A5CNFSM4IFV6LO2YY3PNVWWK3TUL52HS4DFVNDWS43UINXW23LFNZ2KUY3PNVWWK3TUL5UWJTQAF6X6G#gistcomment-3125219>, or unsubscribe <https://github.com/notifications/unsubscribe-auth/AF72YZVPVV6DSDQZWPU6ZK3Q3WH63ANCNFSM4IFV6LOQ> .

пт, 3 янв. 2020 г. в 14:16, Anton Ouroukov <ouroukov@gmail.com>:

…

Привет! Ну ты додумался 2-го января писать! Я в некондиции до 9-го ;-) Высылаю тебе рабочий прототип, покопайся пока в нем, копирайта нет, т.к. все это безнадежно устарело 1-го января. Если есть какие вопросы, то пиши 9-го. А по ошибке: переменная или свойство имеет неверный тип. Например, переменная целого типа, не может принимать строковые значения, которые не распознаются как целые числа Открой дебаггер и посмотри типы переменных или пришли мне сам файл, я посмотрю, у меня чет не правильно копируется в проект. чт, 2 янв. 2020 г. в 11:14, sergslip ***@***.***>: > хотел применить код к базе банков по бик . Не получается что не так? > > [image: Screenshot_2] > <https://user-images.githubusercontent.com/59432455/71655561-3e4a7000-2d2f-11ea-85d5-2645068374b1.jpg> > > мой код > Private Const API_KEY = "------------------------------" > > 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/bank" & 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") > Range("C1").Value = Company("correspondent_account") > > Range("d1").Value = Company("bic") > > > > 'Range("q1").Value = Company("state")("status") > > 'Range("r1").Value = Company("type") > > > > > > End If > > > End Sub > > — > You are receiving this because you commented. > Reply to this email directly, view it on GitHub > <https://gist.github.com/b5d0c7b72bb6b393475ae67e73c86ed3?email_source=notifications&email_token=AF72YZWAMDXPMDJ63CIZY4TQ3WH63A5CNFSM4IFV6LO2YY3PNVWWK3TUL52HS4DFVNDWS43UINXW23LFNZ2KUY3PNVWWK3TUL5UWJTQAF6X6G#gistcomment-3125219>, > or unsubscribe > <https://github.com/notifications/unsubscribe-auth/AF72YZVPVV6DSDQZWPU6ZK3Q3WH63ANCNFSM4IFV6LOQ> > . >