nalgeon/README.md

## README.md

      
  Raw
  

              README.md
            
          
    Пример вызова Подсказок DaData.ru из Excel
Как подключить пример

Откройте Excel и включите отображение вкладки «Разработчик»
Перейдите в редактор Visual Basic (в ленте Разработчик > Visual Basic).
Откройте список ссылок: в меню Tools > References...
Отметьте пункты «Microsoft Scripting Runtime» и «Microsoft VBScript Regular Expressions 5.5». Нажмите OK.
Скачайте архив с библиотекой VBA-JSON. Распакуйте его.
В меню File > Import file... выберите JsonConverter.bas из распакованного архива.
Откройте модуль Лист1.
Скопируйте код из примера в модуль.
Замените значение константы 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
	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