Create a gist now

Instantly share code, notes, and snippets.

@nalgeon /README.md
Last active Nov 30, 2017

What would you like to do?
Пример вызова Подсказок DaData.ru из Excel

Как подключить пример

  1. Откройте Excel и перейдите в редактор Visual Basic (в ленте Разработчик > Visual Basic).
  2. Откройте список ссылок: в меню Tools > References...
  3. Отметьте пункты «Microsoft Scripting Runtime» и «Microsoft VBScript Regular Expressions 5.5».
  4. Нажмите OK.
  5. Откройте модуль Лист1.
  6. Скопируйте код из примера в модуль.
  7. Замените значение константы API_KEY с CHANGE_ME на ваш API-ключ.

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

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

Private Const API_KEY = "CHANGE_ME"
Private pCachedRegexes As Dictionary
Public Function GetRegex( _
ByVal pattern As String, _
Optional ByVal IgnoreCase As Boolean = True, _
Optional ByVal MultiLine As Boolean = True, _
Optional ByVal MatchGlobal As Boolean = True) As RegExp
' Ensure the dictionary has been initialized
If pCachedRegexes Is Nothing Then Set pCachedRegexes = New Dictionary
' Build the unique key for the regex: a combination
' of the boolean properties and the pattern itself
Dim rxKey As String
rxKey = IIf(IgnoreCase, "1", "0") & _
IIf(MultiLine, "1", "0") & _
IIf(MatchGlobal, "1", "0") & _
pattern
' If the RegExp object doesn't already exist, create it
If Not pCachedRegexes.Exists(rxKey) Then
Dim oRegExp As New RegExp
With oRegExp
.pattern = pattern
.IgnoreCase = IgnoreCase
.MultiLine = MultiLine
.Global = MatchGlobal
End With
Set pCachedRegexes(rxKey) = oRegExp
End If
' Fetch and return the pre-compiled RegExp object
Set GetRegex = pCachedRegexes(rxKey)
End Function
Function Utf8ToAscii(ByVal txt) As String
On Error Resume Next: Err.Clear
With CreateObject("ADODB.Stream")
.Type = 1
.Open
.Write txt
.Position = 0
.Type = 2
.Charset = "UTF-8"
Utf8ToAscii = .ReadText
.Close
End With
End Function
Function Suggest(ByVal name, ByVal query, ByVal count) As String
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
suggestions = Replace(http.responseText, "\""", "")
Debug.Print suggestions
Suggest = suggestions
End Function
Function Extract(ByVal fieldName, ByVal suggestion)
rePattern = "^.+""" & fieldName & """:""([^""]+)"".+$"
Debug.Print "Pattern: " & rePattern
Dim re As RegExp
Set re = GetRegex(rePattern)
If re.Test(suggestion) Then
result = re.Replace(suggestion, "$1")
Else
result = ""
End If
Debug.Print "Extracted: " & result
Extract = result
End Function
Function ExtractName(suggestion) As String
ExtractName = Extract("suggestions.....value", suggestion)
End Function
Function ExtractOGRN(suggestion) As String
ExtractOGRN = Extract("ogrn", suggestion)
End Function
Function ExtractINN(suggestion) As String
ExtractINN = Extract("inn", suggestion)
End Function
Function ExtractKPP(suggestion) As String
ExtractKPP = Extract("kpp", suggestion)
End Function
Function ExtractOKVED(suggestion) As String
ExtractOKVED = Extract("okved", suggestion)
End Function
Function ExtractAddress(suggestion) As String
ExtractAddress = Extract("address....value", suggestion)
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
suggested = Suggest("party", Target.Value, 1)
'Debug.Print "Suggested: " & suggested
Range("B1").Value = ExtractName(suggested)
Range("C1").Value = ExtractOGRN(suggested)
Range("D1").Value = ExtractINN(suggested)
Range("E1").Value = ExtractKPP(suggested)
Range("F1").Value = ExtractOKVED(suggested)
Range("G1").Value = ExtractAddress(suggested)
End If
End Sub
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment