Skip to content

Instantly share code, notes, and snippets.

@nalgeon

nalgeon/README.md

Last active Sep 7, 2020
Embed
What would you like to do?
Пример вызова Стандартизации DaData.ru из Excel

Пример вызова Стандартизации 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 платное, оплачивается за каждый запрос.

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
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
You can’t perform that action at this time.