Sub T_TOEICをJSONに変換する()
    Dim jsonPath As String
    Dim ws As Worksheet
    Dim lo As ListObject
    Dim rw As ListRow
    Dim jsonText As String
    Dim stm As Object
    Dim i As Long

    jsonPath = ThisWorkbook.path & "\data.json"

    If Dir(jsonPath) <> "" Then Kill jsonPath

    On Error Resume Next

    For i = ThisWorkbook.Connections.Count To 1 Step -1
        ThisWorkbook.Connections(i).Delete
    Next i

    For i = ThisWorkbook.Queries.Count To 1 Step -1
        ThisWorkbook.Queries(i).Delete
    Next i

    On Error GoTo 0

    Set ws = ThisWorkbook.Worksheets("TOEIC600語彙問題")
    Set lo = ws.ListObjects("T_TOEIC")

    jsonText = "["

    For Each rw In lo.ListRows

        jsonText = jsonText & "{" & _
            """id"":" & JsonValue(rw.Range.Cells(1, lo.ListColumns("ID").Index).Value) & "," & _
            """question"":" & JsonValue(rw.Range.Cells(1, lo.ListColumns("問題").Index).Value) & "," & _
            """a"":" & JsonValue(rw.Range.Cells(1, lo.ListColumns("a").Index).Value) & "," & _
            """b"":" & JsonValue(rw.Range.Cells(1, lo.ListColumns("b").Index).Value) & "," & _
            """c"":" & JsonValue(rw.Range.Cells(1, lo.ListColumns("c").Index).Value) & "," & _
            """d"":" & JsonValue(rw.Range.Cells(1, lo.ListColumns("d").Index).Value) & "," & _
            """correct"":" & JsonValue(rw.Range.Cells(1, lo.ListColumns("correct").Index).Value) & "," & _
            """example"":" & JsonValue(rw.Range.Cells(1, lo.ListColumns("example").Index).Value) & "," & _
            """translation"":" & JsonValue(rw.Range.Cells(1, lo.ListColumns("translation").Index).Value) & _
            "},"

    Next rw

    If Right$(jsonText, 1) = "," Then
        jsonText = Left$(jsonText, Len(jsonText) - 1)
    End If

    jsonText = jsonText & "]"

    Set stm = CreateObject("ADODB.Stream")

    With stm
        .Type = 2
        .Charset = "UTF-8"
        .Open
        .WriteText jsonText
        .SaveToFile jsonPath, 2
        .Close
    End With

    Set stm = Nothing
       
    On Error Resume Next

    For i = ThisWorkbook.Connections.Count To 1 Step -1
        ThisWorkbook.Connections(i).Delete
    Next i

    For i = ThisWorkbook.Queries.Count To 1 Step -1
        ThisWorkbook.Queries(i).Delete
    Next i
End Sub

Private Function JsonValue(ByVal v As Variant) As String
    Dim s As String

    If IsNull(v) Or IsEmpty(v) Then
        JsonValue = "null"
        Exit Function
    End If

    If IsNumeric(v) Then
        JsonValue = CStr(v)
        Exit Function
    End If

    s = CStr(v)

    s = Replace(s, "\", "\\")
    s = Replace(s, """", "\""")
    s = Replace(s, vbCrLf, "\n")
    s = Replace(s, vbCr, "\n")
    s = Replace(s, vbLf, "\n")

    JsonValue = """" & s & """"
End Function
