SQLServer テーブル定義の取得

不具合あり！

テーブル定義情報を取得してＥｘｃｅｌに出力する (テーブル別)

テーブル定義 取得用 SQL

lesson004.sql

select

    c.table_name

,   c.ordinal_position

,   c.column_name

,   c.data_type

,   c.character_maximum_length

,   c.numeric_precision

,   c.numeric_scale

,   c.is_nullable

,   c.column_default

,   p.constraint_type

from

    information_schema.columns      c

left outer join

    (

        select

            k.table_catalog

        ,   k.table_schema

        ,   k.table_name

        ,   k.column_name

        ,   t.constraint_type

        from 

            information_schema.key_column_usage     k

        inner join 

            information_schema.table_constraints    t

        on 

            (   t.constraint_name   =   k.constraint_name   )

    )

    p

on 

        (   c.table_catalog =   p.table_catalog     )

    and (   c.table_schema  =   p.table_schema      )

    and (   c.table_name    =   p.table_name        )

    and (   c.column_name   =   p.column_name       )

order by

    c.table_name

,   c.ordinal_position

接続文字列

lesson004.con

DRIVER={SQL Server};SERVER=xxxxxx;DataBase=adventureworksdw;UID=yyyyyy;PWD=zzzzzz;

Ｅｘｃｅｌ出力用スクリプト

lesson012.vbs

Option Explicit

Private fs
Set fs = CreateObject("Scripting.FileSystemObject")

'接続文字列 読み込み
Private tsCon
Set tsCon = fs.OpenTextFile(WScript.Arguments(0))

Private sCon
sCon = ""
If Not tsCon.AtEndOfStream Then
    sCon = tsCon.ReadLine
End If
tsCon.Close
Set tsCon = Nothing

'接続
Private con
Set con = CreateObject("ADODB.Connection")
With con
    .Provider         = "SQLOLEDB"
    .ConnectionString = sCon
    .Open
End With

'SQL 読み込み
Private tsSql
Set tsSql = fs.OpenTextFile(WScript.Arguments(1))

Private sSql
sSql = ""
Do Until tsSql.AtEndOfStream
    sSql = sSql & tsSql.ReadLine & vbNewLine
Loop
tsSql.Close
Set tsSql = Nothing
Set fs    = Nothing

Dim rs
Set rs = CreateObject("ADODB.Recordset")
With rs
    .ActiveConnection = con
    .CursorType       = 0 'adOpenForwardOnly
    .LockType         = 1 'adLockReadOnly
    .Source           = sSql
    .Open
End With


If Not rs.EOF Then
    '結果を Excel に保存
    Dim excelApp
    Set excelApp = CreateObject("Excel.Application")
    excelApp.Visible       = True
    excelApp.DisplayAlerts = False '警告メッセージをOFF

    'ブックを書き込み用で開く
    Dim excelBook
    Set excelBook = excelApp.Workbooks.Add

    'シートを１枚だけにする
    Dim iSheet
    For iSheet = excelBook.WorkSheets.Count To 2 Step -1
        excelBook.WorkSheets(iSheet).Delete
    Next

    Dim tableNameList()
    Dim tableCount: tableCount = -1
    Dim tableName:  tableName  = ""

    Dim iRow:       iRow       = 0
    Dim iCol:       iCol       = 0
    Dim excelSheet

    Do Until rs.EOF
        If tableName <> rs("table_name") & "" Then
            tableName = rs("table_name") & ""

            tableCount = tableCount + 1
            ReDim Preserve tableNameList(tableCount)
            tableNameList(tableCount) = tableName

            excelBook.Sheets.Add , excelBook.WorkSheets(tableCount + 1)

            Set excelSheet  = excelBook.WorkSheets(tableCount + 2)
            excelSheet.Name = tableName

            excelSheet.Cells(1, 1).Value = "No."
            excelSheet.Cells(1, 2).Value = "項目名"
            excelSheet.Cells(1, 3).Value = "型"
            excelSheet.Cells(1, 4).Value = "長さ"
            excelSheet.Cells(1, 5).Value = "小数部"
            excelSheet.Cells(1, 6).Value = "初期値"
            excelSheet.Cells(1, 7).Value = "必須"
            excelSheet.Cells(1, 8).Value = "制約"

            iRow = 1
        End If
        iRow = iRow + 1
        iCol = 0

        'No.
        iCol = iCol + 1
        excelSheet.Cells(iRow, iCol).Value = rs("ordinal_position") & ""

        '項目名
        iCol = iCol + 1
        excelSheet.Cells(iRow, iCol).Value =  rs("column_name") & ""

        '型
        iCol = iCol + 1
        excelSheet.Cells(iRow, iCol).Value =  rs("data_type") & ""

        '長さ
        iCol = iCol + 1
        Select Case LCase(rs("data_type") & "")
            Case "nvarchar", "nchar", "varchar", "char"
                excelSheet.Cells(iRow, iCol).Value =  rs("character_maximum_length") & ""
            Case "decimal"
                excelSheet.Cells(iRow, iCol).Value =  rs("numeric_precision")        & ""
        End Select

        '小数部
        iCol = iCol + 1
        Select Case LCase(rs("data_type") & "")
            Case "decimal"
                excelSheet.Cells(iRow, iCol).Value = rs("numeric_scale") & ""
        End Select

        '初期値
        iCol = iCol + 1
        excelSheet.Cells(iRow, iCol).Value = rs("column_default") & ""

        '必須
        iCol = iCol + 1
        Dim s: s = rs("is_nullable") & ""
        If UCase(s) = "NO" Then
            excelSheet.Cells(iRow, iCol).Value = "○"
        End If

        '制約
        iCol = iCol + 1
        excelSheet.Cells(iRow, iCol).Value = rs("constraint_type") & ""

        rs.MoveNext
    Loop

    Set excelSheet  = excelBook.WorkSheets(1)
    excelSheet.Name = "テーブル一覧"

    For iRow = 1 To tableCount + 1
        excelSheet.Cells(iRow, 1).Value = tableNameList(iRow - 1)
        excelSheet.Hyperlinks.Add excelSheet.Cells(iRow, 1), "", tableNameList(iRow - 1) & "!A1"
    Next

    'ブックを保存する
    excelBook.SaveAs(WScript.Arguments(2))
    excelApp.Quit 
    Set excelApp = Nothing
End If
rs.Close

'切断
con.Close
Set con = Nothing

実行形式

C:\>cscript c:\study\vbscript\chapter006\lesson012.vbs  c:\study\vbscript\chapte

r006\lesson004.con c:\study\vbscript\chapter006\lesson004.sql c:\study\vbscript\

chapter006\lesson12.xls //nologo

出力イメージ

Sheet : "テーブル一覧"

AdventureWorksDWBuildVersion

DatabaseLog

DimAccount

DimCurrency

Sheet : "AdventureWorksDWBuildVersion"

No.	項目名	型	長さ	小数部	初期値	必須	制約
1	DBVersion	nvarchar	50
2	VersionDate	datetime

Sheet : "DatabaseLog"

No.	項目名	型	長さ	小数部	初期値	必須	制約
1	DatabaseLogID	int				○
2	PostTime	datetime				○
3	DatabaseUser	nvarchar	128			○
4	Event	nvarchar	128			○
5	Schema	nvarchar	128
6	Object	nvarchar	128
7	TSQL	nvarchar	-1			○
8	XmlEvent	xml				○

Sheet : "DimAccount"

No.	項目名	型	長さ	小数部	初期値	必須	制約
1	AccountKey	int				○	PRIMARY KEY
2	ParentAccountKey	int					FOREIGN KEY
3	AccountCodeAlternateKey	int
4	ParentAccountCodeAlternateKey	int
5	AccountDescription	nvarchar	50
6	AccountType	nvarchar	50
7	Operator	nvarchar	50
8	CustomMembers	nvarchar	300
9	ValueType	nvarchar	50
10	CustomMemberOptions	nvarchar	200

Sheet : "DimCurrency"

No.	項目名	型	長さ	小数部	初期値	必須	制約
1	CurrencyKey	int				○	PRIMARY KEY
2	CurrencyAlternateKey	nchar	3			○	UNIQUE
3	CurrencyName	nvarchar	50			○

不具合発見！

Sheet : "FactInternetSalesReason"

No.	項目名	型	長さ	小数部	初期値	必須	制約
1	SalesOrderNumber	nvarchar	20			○	UNIQUE
1	SalesOrderNumber	nvarchar	20			○	FOREIGN KEY
2	SalesOrderLineNumber	tinyint				○	UNIQUE
2	SalesOrderLineNumber	tinyint				○	FOREIGN KEY
3	SalesReasonKey	int				○	UNIQUE
3	SalesReasonKey	int				○	FOREIGN KEY