Создание JSON-файла

Создание простого файла JSON (текстовый формат обмена данными) с помощью VBA Excel. Сохранение JSON-файла в стандартной кодировке UTF-8 без маркера BOM.

Содержание

Исходные данные

Однажды мне понадобилось сделать простой JSON-файл для формы поиска жд билетов с 1336 парами ключ-значение:

Первый мой генератор JSON сработал неудачно — я не учёл, что для JSON-файла в обязательном порядке требуется кодировка UTF-8 без маркера BOM. Наличие BOM-байтов в начале файла часто вызывает критические ошибки парсинга в программах и библиотеках.

Код генератора

Код VBA Excel для создания JSON-файла в кодировке UTF-8 без маркера BOM:

Sub Stations_slug_map_json_UTF8()
    Dim myArray
    myArray = Worksheets("Список СНГ").Range("A1").CurrentRegion.Value
    
    Dim jsonText As String
    jsonText = "{" & vbNewLine
    
    Dim i As Long
    For i = 2 To UBound(myArray)
        jsonText = jsonText & "  """ & Trim(myArray(i, 1)) & """: """ & Trim(myArray(i, 2)) & """"
        If i <> UBound(myArray) Then
            jsonText = jsonText & "," & vbNewLine
        Else
            jsonText = jsonText & vbNewLine
        End If
    Next i
    jsonText = jsonText & "}"
    
    ' Сохраняем как UTF-8 без BOM с помощью ADODB.Stream
    Dim stream As Object
    Set stream = CreateObject("ADODB.Stream")
    stream.Type = 2        ' текстовый
    stream.Charset = "utf-8"
    stream.Open
    stream.WriteText jsonText
    stream.SaveToFile "C:\test\stations_slug_map.json", 2   ' 2 = перезаписать
    stream.Close
    Set stream = Nothing
    
    MsgBox "Файл сохранён в UTF-8", vbInformation
End Sub

Sub Stations_slug_map_json_UTF8()

Dim myArray

myArray = Worksheets("Список СНГ").Range("A1").CurrentRegion.Value

Dim jsonText As String

jsonText = "{" & vbNewLine

Dim i As Long

For i = 2 To UBound(myArray)

jsonText = jsonText & " """ & Trim(myArray(i, 1)) & """: """ & Trim(myArray(i, 2)) & """"

If i <> UBound(myArray) Then

jsonText = jsonText & "," & vbNewLine

Else

jsonText = jsonText & vbNewLine

End If

Next i

jsonText = jsonText & "}"

' Сохраняем как UTF-8 без BOM с помощью ADODB.Stream

Dim stream As Object

Set stream = CreateObject("ADODB.Stream")

stream.Type = 2 ' текстовый

stream.Charset = "utf-8"

stream.Open

stream.WriteText jsonText

stream.SaveToFile "C:\test\stations_slug_map.json", 2 ' 2 = перезаписать

stream.Close

Set stream = Nothing

MsgBox "Файл сохранён в UTF-8", vbInformation

End Sub

Результат работы кода:

Благодаря использованию в цикле обхода элементов массива, а не ячеек, JSON-файл создаётся мгновенно.

Содержание рубрики VBA Excel по тематическим разделам со ссылками на все статьи.