Пример вызова Подсказок 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.