Пример вызова Стандартизации 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-ключ.
10. Замените значение константы SECRET_KEY с CHANGE_ME на ваш секретный ключ.

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

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

Обратите внимание, что это API платное, оплачивается за каждый запрос.

clean.cls

Private Const API_KEY = "CHANGE_ME"
Private Const SECRET_KEY = "CHANGE_ME"

Function DecodeText(ByVal text, ByVal fromCharset, ByVal toCharset) As String
    Dim stream
    Set stream = CreateObject("ADODB.Stream")
    stream.Type = 2
    stream.Mode = 3
    stream.Charset = fromCharset
    stream.Open
    stream.WriteText text
    stream.Position = 0
    stream.Charset = toCharset
    DecodeText = stream.ReadText(-1)
    stream.Close
End Function
  
Function Clean(ByVal name, ByVal query) As Object
    Dim http
    Set http = CreateObject("WinHttp.WinHttpRequest.5.1")
    timeout = 2000 'milliseconds
    http.setTimeouts timeout, timeout, timeout, timeout
    request = "[ """ & query & """ ]"
    http.Open "POST", "https://cleaner.dadata.ru/api/v1/clean/" & name
    http.setRequestHeader "Content-Type", "application/json"
    http.setRequestHeader "Authorization", "Token " & API_KEY
    http.setRequestHeader "X-Secret", SECRET_KEY
    http.send request
    text = DecodeText(http.responseText, "ISO-8859-1", "UTF-8")
    Debug.Print text
    Set Clean = JsonConverter.ParseJson(text)
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 Cleaned As Object
        Set Cleaned = Clean("address", Target.Value)
        Dim Address As Object
        Set Address = Cleaned(1)
        Range("B1").Value = Address("postal_code")
        Range("C1").Value = Address("result")
        Range("D1").Value = Address("qc")
    End If
End Sub