Skip to content

Instantly share code, notes, and snippets.

@nalgeon
Last active Jun 9, 2021
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