SQL Server输出表格设计信息（表结构）

SELECT 
    表名	   = d.name,
    字段名     = a.name,
    标识       = case when COLUMNPROPERTY( a.id,a.name,'IsIdentity')=1 then '√'else '' end,
    主键       = case when exists(SELECT 1 FROM sysobjects where xtype='PK' and parent_obj=a.id and name in (
                     SELECT name FROM sysindexes WHERE indid in( SELECT indid FROM sysindexkeys WHERE id = a.id AND colid=a.colid))) then '√' else '' end,
    类型       = b.name,
    长度       = COLUMNPROPERTY(a.id,a.name,'PRECISION'),
    小数位数   = isnull(COLUMNPROPERTY(a.id,a.name,'Scale'),0),
    允许空     = case when a.isnullable=1 then '√'else '' end,
    默认值     = isnull(e.text,''),
    字段说明   = isnull(g.[value],'')
FROM syscolumns a 
left join systypes b on a.xusertype=b.xusertype
inner join sysobjects d on a.id=d.id  and d.xtype='U' and  d.name<>'dtproperties'
left join syscomments e on a.cdefault=e.id
left join sys.extended_properties g on a.id=G.major_id and a.colid=g.minor_id  
left join sys.extended_properties f on d.id=f.major_id and f.minor_id=0
-- where d.name='Books'    
order by a.id,a.colorder

SELECT 
    TABLE_NAME as "表名",
    COLUMN_NAME as "字段名",
    CASE WHEN IDENTITY_COLUMN = 'YES' THEN '√' ELSE '' END as "标识",
    CASE WHEN EXISTS (
        SELECT 1 FROM USER_CONS_COLUMNS ucc
        JOIN USER_CONSTRAINTS uc ON ucc.CONSTRAINT_NAME = uc.CONSTRAINT_NAME
        WHERE ucc.TABLE_NAME = utc.TABLE_NAME 
        AND ucc.COLUMN_NAME = utc.COLUMN_NAME
        AND uc.CONSTRAINT_TYPE = 'P'
    ) THEN '√' ELSE '' END as "主键",
    DATA_TYPE as "类型",
    DATA_LENGTH as "长度",
    NVL(DATA_PRECISION, 0) as "精度",
    NVL(DATA_SCALE, 0) as "小数位数",
    CASE WHEN NULLABLE = 'Y' THEN '√' ELSE '' END as "允许空",
    DATA_DEFAULT as "默认值",
    (SELECT COMMENTS FROM USER_COL_COMMENTS 
     WHERE TABLE_NAME = utc.TABLE_NAME AND COLUMN_NAME = utc.COLUMN_NAME) as "字段说明"
FROM USER_TAB_COLUMNS utc
ORDER BY TABLE_NAME, COLUMN_ID;

Sub SaveTableToJSON()
    Dim oSheet As Object, oCursor As Object
    Dim i As Long, j As Long, startRow As Long, endRow As Long, startCol As Long, endCol As Long
    Dim jsonText As String, cellValue As String
    
    ' 获取数据范围
    oSheet = ThisComponent.getSheets().getByIndex(0)
    oCursor = oSheet.createCursor()
    oCursor.gotoEndOfUsedArea(True)
    startRow = oCursor.getRangeAddress().StartRow
    endRow = oCursor.getRangeAddress().EndRow
    startCol = oCursor.getRangeAddress().StartColumn
    endCol = oCursor.getRangeAddress().EndColumn
    
    ' 构建JSON
    jsonText = "const data = [" + Chr(13) + Chr(10)
    For i = startRow To endRow
        jsonText = jsonText + IIf(i > startRow, ",", "") + "["
        For j = startCol To endCol
            cellValue = oSheet.getCellByPosition(j, i).getString()
            If cellValue = "" Then
                cellValue = "null"
            Else
                cellValue = Replace(Replace(Replace(cellValue, "\", "\\"), """", "\"""), Chr(10), "\n")
                cellValue = """" + cellValue + """"
            End If
            jsonText = jsonText + IIf(j > startCol, ",", "") + cellValue
        Next j
        jsonText = jsonText + "]" + Chr(13) + Chr(10)
    Next i
    jsonText = jsonText + "]"
    
    Dim sUrl as String
    sUrl = "C:/Doc/data.js"
    Dim fileNo As Integer
    fileNo = FreeFile()
    Open sUrl for output as fileNo
	Print #fileNo, jsonText

    MsgBox "JSON文件已保存！"
End Sub

Sub SaveTableToJSON()
    Dim ws As Worksheet
    Dim usedRng As Range
    Dim i As Long, j As Long
    Dim jsonText As String, cellValue As String
    Dim filePath As String
    Dim fileNo As Integer
    
    Set ws = ActiveSheet
    Set usedRng = ws.UsedRange
    If usedRng Is Nothing Then
        MsgBox "工作表中没有数据！"
        Exit Sub
    End If
    
    jsonText = "const data = [" & vbCrLf
    For i = 1 To usedRng.Rows.Count
        jsonText = jsonText & IIf(i > 1, ",", "") & "["
        For j = 1 To usedRng.Columns.Count
            cellValue = usedRng.Cells(i, j).Value
            
            If IsEmpty(cellValue) Or cellValue = "" Then
                cellValue = "null"
            Else
                cellValue = Replace(Replace(Replace(cellValue, "\", "\\"), """", "\"""), vbLf, "\n")
                cellValue = Replace(Replace(cellValue, vbCr, "\n"), vbCrLf, "\n")
                cellValue = """" & cellValue & """"
            End If
            
            jsonText = jsonText & IIf(j > 1, ",", "") & cellValue
        Next j
        jsonText = jsonText & "]" & vbCrLf
    Next i
    jsonText = jsonText & "]"
    
    filePath = Application.GetSaveAsFilename(InitialFileName:="data.js", FileFilter:="JS Files (*.js), *.js")
    If filePath = "False" Then Exit Sub
    
    fileNo = FreeFile()
    Open filePath For Output As fileNo
    Print #fileNo, jsonText
    Close fileNo
    
    MsgBox "JSON文件已保存！"
End Sub