Excelの定義書からVBAでSQLを作成する

仕事で使うテーブル定義書がExcelで作られていることが多いです。

そして、どの現場でもその定義書からCREATE文やINSERT文を作ることが多いです。自分の単体テスト環境を作るときなどです。

せっかくテーブル定義書がExcelなので、VBAで作ることが多いのですが、毎回作ってる気がしたので、テンプレート化して置いておくことにしました。

今回は自分が使うことが多いOracleで作ろうと思いますが、他のDBでも基本的に型くらいしか違わない気もするので、ちょっと修正すれば使い回せる気がします。

ちなみにビューも自動生成したいなって思ったんですが、そう言えばビューってどう定義書作るのが一般的なんですかね?

CASE文とかWHERE句が複雑な場合、定義書で表しきれるのだろうか?もし日本語でゴチャゴチャ説明が書かれていたら難しそうですね。

今回のマクロで利用するテーブル定義書のサンプル

今回のコードでは以下のテーブル定義書からSQLを作成することにします。表領域とかスキーマとか考えたらキリがないので定義しないことにします。

マクロで利用するテーブル定義書のサンプル

今回はテーブル物理名をcells(1,4).value、テーブル論理名をcells(2,4).valueから取得してくるようにします。

今回はセルのアドレスを固定で持たせようと思いますが、もしも定義書でセルの位置が統一されていない場合はFindを使って動的に場所を取得するのが良いかと思います。

詳細は以下の記事に記載をしています。

CREATE文を作成するマクロ

とりあえず、最も使いそうなCREATE文(DDL)を作成するVBAマクロを作ってみることにしました。

ソースは以下になります。

'=====定数定義=====
'テーブル物理名のセル番号
Private Const COL_TABLE_NAME As Integer = 4
Private Const ROW_TABLE_NAME As Long = 1

'テーブル論理名のセル番号
Private Const COL_TABLE_COMMENT As Integer = 4
Private Const ROW_TABLE_COMMENT As Long = 2

'項目開始行
Private Const ROW_COLUMNS_START As Long = 5
'項目の列定義
Enum enm_columns
    NO = 2          'No
    COLUMN_NAME     '項目物理名
    COLUMN_COMMENT  '項目論理名
    COLUMN_TYPE     '型
    DIGITS          '桁数
    FRACTION        '小数
    NOTNULL         'NOTNULL
    PK              'PK
    REMARK          '備考
End Enum

'=====モジュール変数定義=====
Private tableName As String
Private tableComment As String

'メイン関数
Public Sub outputCreate()
    Dim wb As Workbook
    Set wb = openExcel()
    
    Dim sh As Worksheet
    Set sh = wb.Worksheets("テーブル定義書")
    
    'テーブル物理名と論理名を取得
    tableName = sh.Cells(ROW_TABLE_NAME, COL_TABLE_NAME).Value
    tableComment = sh.Cells(ROW_TABLE_COMMENT, COL_TABLE_COMMENT).Value
    
    'テーブル物理名が取れなければ終了
    If tableName = "" Then
        MsgBox "テーブルの物理名が不正です"
        GoTo errProc
    End If
    
    'SQLファイル保存先を指定
    Dim outputPath As String
    outputPath = getSavePath()
    
    'SQL文を格納する変数を初期化
    Dim sql As String
    sql = "CREATE TABLE " & tableName & " (" & vbCrLf
    
    Dim row As Long
    '項目名の数だけループ
    For row = ROW_COLUMNS_START To sh.Cells(sh.Rows.count, enm_columns.NO).End(xlUp).row
        'インデント(スペース4文字)を付加
        Call addIndent(sql, 1)
        
        '1項目目以外ならカンマを付与
        If row > ROW_COLUMNS_START Then
            sql = sql & ","
        End If
        
        '項目名
        sql = sql & sh.Cells(row, enm_columns.COLUMN_NAME).Value
        
        '型
        sql = sql & " " & sh.Cells(row, enm_columns.COLUMN_TYPE).Value
        
        '桁数
        Select Case sh.Cells(row, enm_columns.COLUMN_TYPE).Value
            Case "DATE", "TIMESTAMP"
                '日付型は桁数指定なし
            Case Else
                If sh.Cells(row, enm_columns.FRACTION).Value = "" Then
                    '小数なし
                    sql = sql & "(" & sh.Cells(row, enm_columns.DIGITS).Value & ")"
                Else
                    '小数あり
                    sql = sql & "(" & sh.Cells(row, enm_columns.DIGITS).Value & "," & sh.Cells(row, enm_columns.FRACTION).Value & ")"
                End If
        End Select
        
        'NOT NULL
        If Not sh.Cells(row, enm_columns.NOTNULL).Value = "" Then
            sql = sql & " NOT NULL"
        End If
        
        'PK
        If Not sh.Cells(row, enm_columns.PK).Value = "" Then
            sql = sql & " PRIMARY KEY"
        End If
        
         sql = sql & vbCrLf
    Next row
    
    sql = sql & ");"
    'ファイル書き出しを行う(無ければ新規作成、あれば上書き)
    Dim ff As Integer
    ff = FreeFile
    Open outputPath For Output As ff
    Print #ff, sql
    Close ff
    
errProc:
    wb.Close
End Sub

Private Sub addIndent(ByRef sql As String, ByVal count As Integer)
    Dim i As Integer
    For i = 1 To count
        sql = sql & "    "
    Next i
End Sub

Private Function openExcel() As Workbook
    On Error GoTo errProc
    Dim OpenFileName As Variant
    OpenFileName = Application.GetOpenFilename("テーブル定義書,*.xls?")
    
    'キャンセルされたら終了
    If OpenFileName = False Then End
    Set openExcel = Workbooks.Open(FileName:=OpenFileName, ReadOnly:=True)
    Exit Function
    
errProc:
    MsgBox "テーブル定義書が開けませんでした。"
End Function

Private Function getSavePath() As String
    Dim FileName As Variant
    FileName = Application.GetSaveAsFilename(InitialFileName:=tableName, FileFilter:="SQLファイル,*.sql*")
    
    'キャンセルされたら終了
    If FileName = False Then End
    getSavePath = FileName & "sql"
End Function

実行すると、まずテーブル定義書を選択するダイアログが開くので、ここでテーブル定義書を指定します。

もう一度ダイアログが開くので、SQLの保存先を指定します。

実行結果

CREATE TABLE USER (
    USER_NO NUMBER(6) NOT NULL PRIMARY KEY
    ,USER_NAME VERCHAR2(20)
    ,DELETE_FLG CHAR(1) NOT NULL
    ,CREATE_DATE DATE
    ,UPDATE_DATE DATE
);

それにしても2回連続でダイアログが開くのは格好が悪いし、わけわからない印象を与えてしまいますね。

入力ファイルと出力ファイルの両方を指定するにはどうするのがスマートなんでしょうか。

やっぱりシート上に出力先をもたせるのがスマートですかね。

一層のこと、出力ファイルはマクロを実行しているフォルダと同じフォルダに出力する形でもいいかもしれません。


CREATE文にコメントも出力可能にする

テーブルにコメントを付けたいときもあるので、コメントを出力するバージョンも作成してみたいと思います。

基本的には先程作成したマクロに追記していく形になります。

'=====定数定義=====
'テーブル物理名のセル番号
Private Const COL_TABLE_NAME As Integer = 4
Private Const ROW_TABLE_NAME As Long = 1

'テーブル論理名のセル番号
Private Const COL_TABLE_COMMENT As Integer = 4
Private Const ROW_TABLE_COMMENT As Long = 2

'項目開始行
Private Const ROW_COLUMNS_START As Long = 5
'項目の列定義
Enum enm_columns
    NO = 2          'No
    COLUMN_NAME     '項目物理名
    COLUMN_COMMENT  '項目論理名
    COLUMN_TYPE     '型
    DIGITS          '桁数
    FRACTION        '小数
    NOTNULL         'NOTNULL
    PK              'PK
    REMARK          '備考
End Enum

'=====モジュール変数定義=====
Private tableName As String
Private tableComment As String

'メイン関数
Public Sub outputCreate()
    Dim wb As Workbook
    Set wb = openExcel()
    
    Dim sh As Worksheet
    Set sh = wb.Worksheets("テーブル定義書")
    
    'テーブル物理名と論理名を取得
    tableName = sh.Cells(ROW_TABLE_NAME, COL_TABLE_NAME).Value
    tableComment = sh.Cells(ROW_TABLE_COMMENT, COL_TABLE_COMMENT).Value
    
    'テーブル物理名が取れなければ終了
    If tableName = "" Then
        MsgBox "テーブルの物理名が不正です"
        GoTo errProc
    End If
    
    'SQLファイル保存先を指定
    Dim outputPath As String
    outputPath = getSavePath()
    
    'SQL文を格納する変数を初期化
    Dim sql As String
    sql = "CREATE TABLE " & tableName & " (" & vbCrLf
    
    'カラムコメントを格納する変数を初期化
    Dim colComment As String
    colComment = ""
    
    Dim row As Long
    '項目名の数だけループ
    For row = ROW_COLUMNS_START To sh.Cells(sh.Rows.count, enm_columns.NO).End(xlUp).row
        'インデント(スペース4文字)を付加
        Call addIndent(sql, 1)
        
        '1項目目以外ならカンマを付与
        If row > ROW_COLUMNS_START Then
            sql = sql & ","
        End If
        
        '項目名
        sql = sql & sh.Cells(row, enm_columns.COLUMN_NAME).Value
        
        '型
        sql = sql & " " & sh.Cells(row, enm_columns.COLUMN_TYPE).Value
        
        '桁数
        Select Case sh.Cells(row, enm_columns.COLUMN_TYPE).Value
            Case "DATE", "TIMESTAMP"
                '日付型は桁数指定なし
            Case Else
                If sh.Cells(row, enm_columns.FRACTION).Value = "" Then
                    '小数なし
                    sql = sql & "(" & sh.Cells(row, enm_columns.DIGITS).Value & ")"
                Else
                    '小数あり
                    sql = sql & "(" & sh.Cells(row, enm_columns.DIGITS).Value & "," & sh.Cells(row, enm_columns.FRACTION).Value & ")"
                End If
        End Select
        
        'NOT NULL
        If Not sh.Cells(row, enm_columns.NOTNULL).Value = "" Then
            sql = sql & " NOT NULL"
        End If
        
        'PK
        If Not sh.Cells(row, enm_columns.PK).Value = "" Then
            sql = sql & " PRIMARY KEY"
        End If
        
         sql = sql & vbCrLf
         
         'カラムコメント
         colComment = colComment & "COMMENT ON COLUMN " & tableName & "." & sh.Cells(row, enm_columns.COLUMN_NAME).Value & _
        " IS " & addQuate(sh.Cells(row, enm_columns.COLUMN_COMMENT).Value) & ";" & vbCrLf
    Next row
    
    sql = sql & ");" & vbCrLf
    
    'テーブルコメントを追加
    sql = sql & "COMMENT ON TABLE " & tableName & " IS " & addQuate(tableComment) & ";" & vbCrLf
    
    'カラムコメントを追加
    sql = sql & colComment
    
    'ファイル書き出しを行う(無ければ新規作成、あれば上書き)
    Dim ff As Integer
    ff = FreeFile
    Open outputPath For Output As ff
    Print #ff, sql
    Close ff
    
errProc:
    wb.Close
End Sub

Private Sub addIndent(ByRef sql As String, ByVal count As Integer)
    Dim i As Integer
    For i = 1 To count
        sql = sql & "    "
    Next i
End Sub

Private Function addQuate(str As String) As String
    addQuate = "'" & str & "'"
End Function

Private Function openExcel() As Workbook
    On Error GoTo errProc
    Dim OpenFileName As Variant
    OpenFileName = Application.GetOpenFilename("テーブル定義書,*.xls?")
    
    'キャンセルされたら終了
    If OpenFileName = False Then End
    Set openExcel = Workbooks.Open(FileName:=OpenFileName, ReadOnly:=True)
    Exit Function
    
errProc:
    MsgBox "テーブル定義書が開けませんでした。"
End Function

Private Function getSavePath() As String
    Dim FileName As Variant
    FileName = Application.GetSaveAsFilename(InitialFileName:=tableName, FileFilter:="SQLファイル,*.sql*")
    
    'キャンセルされたら終了
    If FileName = False Then End
    getSavePath = FileName & "sql"
End Function

実行結果

CREATE TABLE USER (
    USER_NO NUMBER(6) NOT NULL PRIMARY KEY
    ,USER_NAME VERCHAR2(20)
    ,DELETE_FLG CHAR(1) NOT NULL
    ,CREATE_DATE DATE
    ,UPDATE_DATE DATE
);
COMMENT ON TABLE USER IS 'ユーザー';
COMMENT ON COLUMN USER.USER_NO IS 'ユーザ番号';
COMMENT ON COLUMN USER.USER_NAME IS 'ユーザ名';
COMMENT ON COLUMN USER.DELETE_FLG IS '削除済フラグ';
COMMENT ON COLUMN USER.CREATE_DATE IS '作成日';
COMMENT ON COLUMN USER.UPDATE_DATE IS '更新日';

作成したマクロ

この記事で紹介したVBAマクロが以下になります。

https://vbaexcel.slavesystems.com/product/SQL作成サンプル.zip


コメントを残す

メールアドレスが公開されることはありません。

日本語が含まれない投稿は無視されますのでご注意ください。(スパム対策)