При конвертации в json наименования на русском языке конвертируются некорректно, т.е. вместо русского шрифта разные символы. Если есть возможность, подскажите, пожалуйста, как это исправить. Как можно вывести в первой строке Json текст с большим количеством кавычек, двоеточий и т.п., например: ""version": "1.0"," ?
Файл приложен. Код внутри файла Книга2. Результат - в jsonExample.
Пытаюсь добавить в код jsonFileExport.WriteLine(""version": "1.0""), но выдает ошибку. Здесь нужно вводить обозначения кавычек, наверное.
И русский шрифт не конвертирует. Вот так: "displayname": "\u041D\u0430\u0438\u043C\u0435\u043D\u043E\u0432\u0430\u043D\u0438\u0435 / \u0424\u0418\u041E"
И русский текст он конвертирует. "\u041D\u0430\u0438\u043C\u0435\u043D\u043E\u0432\u0430\u043D\u0438\u0435 / \u0424\u0418\u041E" - это представление символов кириллицы в Unicode кодировке. Видимо, используемый вами движок по другому не умеет.
Скорее всего - найти другой движок, либо написать свой. Метод ConvertToJson для типа данных String
Код
Case VBA.vbString
' String (or large number encoded as string)
If Not JsonOptions.UseDoubleForLargeNumbers And json_StringIsLargeNumber(JsonValue) Then
ConvertToJson = JsonValue
Else
ConvertToJson = """" & json_Encode(JsonValue) & """"
End If
вызывает метод json_Encode который и преобразовывает в Unicode шестнадцатеричное представление. Можете поменять эту строчку на
Код
ConvertToJson = """" & JsonValue & """"
Но тогда вам придётся самостоятельно преобразовывать кавычки " в \", vbLf d \n, vbCr в \к, vbTab в \t. Посмотрите требования к символам подстановки в JavaScript.
Да, это непростой способ. Не хотелось бы изменять стандартный метод. А может ли помочь применение конструкций типа StrConv(Temp, vbFromUnicode)? Пока эту проблему победить не удалось.
Добрый день! Стандарт json описан здесь (PDF). Поскольку json считается "человеко-читаемым форматом", то вряд ли стоит маскировать буквы русского (или иного) языка. В строке json обязательно должны маскироваться с помощью обратного слеша символы юникода U+0000 - U+001F, двойные кавычки, обратный слеш. Следующая функция кодирует скалярный аргумент (не массив, не объект) в соответствии с json:
Код
Option Explicit
' Кодирует скалярный аргумент в Json
Public Function JsonEncode(ByVal p_s) As String
Dim s As String, i As Long, i2 As Long, n As Long
Select Case VarType(p_s)
Case vbNull
s = "null"
Case vbBoolean
s = IIf(p_s, "true", "false")
Case vbByte, vbCurrency, vbDecimal, vbDouble, vbInteger, vbLong, vbSingle
s = Replace(CStr(p_s), ",", ".")
Case Else
s = """" & Replace(Replace(Replace(p_s, "\", "\\"), """", "\"""), Chr(10), "\n") & """"
' проверяем символы 0-31 и кодируем их
i = 2
i2 = Len(s) - 1
While i <= i2
n = Asc(Mid(s, i, 1))
If n <= 31 Then ' меняем n на \uHHHH, увеличиваем длину на 5 символов
s = Mid(s, 1, i - 1) & "\u00" & IIf(n <= 15, "0", "") & Hex(n) & Mid(s, i + 1)
i = i + 5
i2 = i2 + 5
End If
i = i + 1
Wend
End Select
JsonEncode = s
End Function
Sub test()
Debug.Print JsonEncode("Путь к файлу:" & Chr(10) & """C:\temp\test.json""")
End Sub
sokol92, большое спасибо! Попыталась применить. Возможно, не совсем правильно что-то делаю. Прилагаю файл с кодом процедуры Sub excelToJsonFileExample(). Результат не изменился, так же вместо "description": "Наименование/ФИО" выдается "description": "\u041D\u0430\u0438\u043C\u0435\u043D\u043E\u0432\u0430\u043D\u0438\u0435 / \u0424\u0418\u041E". Не совсем понятно, как применить эту функцию вместе с методом JsonConverter.ConvertToJson(jsonDictionary1, Whitespace:=3). Метод получает значения из словаря jsonDictionary1 и выводит в структурированном виде в json (файл jsonExample прикреплен к первому сообщению, формируется при нажатии на кнопку "Конвертировать в Json).
sokol92, мне удалось решить проблему с формированием json с полностью устраивающей структурой. Прилагается Книга2.xlsm с данными и процедурой, которая вызывается при нажатии на кнопку "Конвертировать в json". Также прилагается сформированный файл jsonExample.
Но не удалось решить проблему с выводом русских слов русским шрифтом, а не в Unicode. Если можно, посоветуйте, как исправить в этом конкретном случае. Ошибка возникает именно при использовании метода ConvertToJson для типа данных String. Возможно, есть какой-то параметр, который нужно добавить, чтобы перекодировать в нормальный читаемый формат.
Также буду очень благодарна, если посмотрите, что получилось, и посоветуете, как можно сделать код рациональнее, например, если вложенных словарей будет, например, не 1, а несколько.
Здравствуйте. Возможно этот пример Вам поможет, но без форматирования.Работает в 32 битном офисе, для 64 надо много править. если отформатировать в нотепаде++, по вид будет такой.
На загрузку json я сделал под 64 .А вот под создание json задача у меня не стояла, я и не адаптировал. Вам надо сделать переопределение некоторых функций под 64 битный офис
sokol92, большое спасибо!! Даже не думала, что решение может быть настолько интересным: "В модуле JsonConverter убрал перекодировку символов с кодами юникода >=127 + Sub StrToFileUTF8(ByVal s, ByVal fileName)". Оказывается, можно варьировать свойствами "ADODB.Stream" и в .Charset устанавливать "utf-8".
Кстати, пробовали то же самое написать на Python, там с utf-8 проще в плане перекодировки. Но вот как это сделать в VBA, было не понятно.
Скриншот после изменений прилагается. Все отображается на русском языке как надо.
Пояснение. Объект ADODB.STREAM при использовании кодировки utf-8 автоматически добавляет маркер utf-8 (BOM), состоящий из 3 байтов. Для исключения BOM приходится открывать второй бинарный поток, копировать в него все байты, кроме первых трех, и уже из второго потока формировать требуемый файл.
Андрей Лящук,конечно интересно! В Книге3.xlsm формируется правильная структура json. Ошибка с кодировкой воспроизводится в варианте, приложенном к сообщению от 16 Апр 2020 22:28:45.
что-то вечер у меня затянулся получилось 3 варианта, и json schema до кучи сделал для Saxon HE (Java) / Altova XmlSpy. Для для работы saxon должна быть установлена JavaSE 8 или JDK 1.8. Вариант Xslt 2.0 можно выполнять через altovaxml2013, должно быть быстрее, чем через Java-машину.
Андрей Лящук, приношу извинения, что не сразу ответила. Очень благодарна, что Вы написали такое универсальное решение! Ваше решение глобальное! Если правильно поняла, оно позволяет уйти от ограничений, которые есть при использовании разных комбинаций Dictionaries/Collections в VBA, и выполнять преобразования данных в Excel в любые структуры json согласно schema.json.
Установила Altova2013. Не могли бы написать, как правильно адаптировать для рассматриваемого случая приведенный по ссылке код процедуры в VBA для запуска?
Код
Sub convert ()
Dim sFolder
sFolder = Replace(WScript.ScriptFullName, WScript.ScriptName, "")
With CreateObject("AltovaXML.Application").XSLT2
.InputXMLFileName = sFolder & "xsd\test1.xsd"
.XSLFileName = sFolder & "xsl\main.xslt"
.AddExternalParameter "SourceFilePath", "'" & sFolder & "src\test.xlsx'"
.AddExternalParameter "DestFolder", "'" & sFolder & "'"
.AddExternalParameter "DestFIle", "'test1.xml'"
.Execute ""
End With
End Sub
С помощью какого инструмента Вы сформировали файлы schema.json, schema.png? В папке с установленной Altova2013 не нашла интерфейса, который позволял бы это делать.
На самом деле мой код на VBA сейчас не совсем корректно отрабатывает при формировании блока Types: вместо "relation": {"table": "table1", "field": "field1", "displayField": "displayField1"} он выдает все то же самое, но в квадратных скобках [], потому что в цикле добавляется jsonDictionary4.Add "relation", jsonItems2 и автоматически проставляются квадратные скобки. А в данном случае нужны именно {}, т.к. в них описывается объект json. А [] вообще не нужны. Как победить эту проблему и можно ли вообще это победить в VBA, я пока не знаю... У Вас в output.json именно {}, как надо.
Код
For i = 2 To excelRange.Rows.Count
If Cells(i, 4) = "recid" Then
If Cells(i, 7) <> "" Then
jsonDictionary3("table") = Cells(i, 1)
jsonDictionary3("field") = "recid"
jsonDictionary3("displayField") = "recid"
jsonItems2.Add jsonDictionary3
Set jsonDictionary3 = Nothing
jsonDictionary4("name") = Cells(i, 7)
jsonDictionary4("type") = "SysRelation"
jsonDictionary4("displayName") = Cells(i, 2)
jsonDictionary4.Add "relation", jsonItems2
jsonItems3.Add jsonDictionary4
Set jsonDictionary4 = Nothing
Set jsonItems2 = Nothing
End If
End If
Next i
YanaK написал: Если правильно поняла, оно позволяет уйти от ограничений, которые есть при использовании разных комбинаций Dictionaries/Collections в VBA, и выполнять преобразования данных в Excel в любые структуры json согласно schema.json
нет, файл schema.json нужен для документирования структуры и валидации json файла, преобразования выполняются согласно xslt шаблонам
Раннее связывание в VBE идем Tools>References> ищем и отмечаем галочкой AltovaXml 1.2 Type Library если не нашлось, жмем Browse идем в папку %ProgramFiles%\Altova\AltovaXML2013\ (в win64 %ProgramFiles(x86)%\Altova\AltovaXML2013\ ), в выпадающем списке над кнопкой Открыть вбираем Executable files , выбираем файл AltovaXML_COM.exe , жмем Открыть Жмем Ок
Код
Sub Excel2JsonEarlyBinding()
Dim XsltProc As New AltovaXMLLib.Application:
Dim inp$, out$
With ThisWorkbook
inp = .FullName
out = Left(inp, InStrRev(inp, ".") - 1) & Format$(Now, "ddMMyyhhmmss") & ".json"
End With
With XsltProc.XSLT2
.XSLFileName = "J:\Xlsx2Json\Stylesheet 2.0.xslt"
.AddExternalParameter "inp", "'" & inp & "'"
.AddExternalParameter "out", "'" & out & "'"
.AddExternalParameter "sht", "'" & ActiveSheet.Name$ & "'"
.InitialTemplateName = "main"
.Execute ""
End With
Shell "explorer /select," & out, vbNormalFocus
End Sub
Позднее связывание (без подключения библиотеки)
Код
Sub Excel2JsonLateBinding()
Dim inp$, out$
With ThisWorkbook
inp = .FullName
out = Left(inp, InStrRev(inp, ".") - 1) & Format$(Now, " ddMMyyhhmmss") & ".json"
End With
With CreateObject("AltovaXML.Application").XSLT2
.XSLFileName = "J:\Xlsx2Json\Stylesheet 2.0.xslt"
.AddExternalParameter "inp", "'" & inp & "'"
.AddExternalParameter "out", "'" & out & "'"
.AddExternalParameter "sht", "'" & ActiveSheet.Name$ & "'"
.InitialTemplateName = "main"
.Execute ""
End With
Shell "explorer /select," & out, vbNormalFocus
End Sub