VBAでデータベースに接続し、テーブル定義書を作る

データベースのテーブル定義書は未だにExcelで作成をしているプロジェクトが多いかと思います。

ほとんどの場合は、「テーブル定義書を作る→テーブルを作る」という順序になるので、Excelの定義書からCreate文を作るということは多いです。

ただ、稀に「テーブル定義書は存在しない。」と言われることもあります。

その際に、自分用にテーブルのカラム一覧などを作成したことが何度かありました。

今後も同じことが起こった時の備忘として対応方法を記載しておこうと思います。

取り急ぎ、VBAでMySQLに接続し、テーブル定義を作成するという方法について記載をいたします。機会があればPostgresSQLやOracleの方法も記載します。

ODBCをインストールする

VBAからデータベースに接続する際ですが、データベースに接続するためのドライバは必ず必要になります。

今回はODBCを使用して接続をすることにします。前述したとおりMySQLに接続するための手順を記載したいと思います。

下記のMySQL公式サイトに接続し、ODBCをダウンロードします。

https://dev.mysql.com/downloads/connector/odbc/

使用しているPCのOSとExcelのBit数に合致しているインストーラをダウンロードします。

自分の場合は、WindowsでExcel64Bitなので下記になります。

2.オラクルアカウントでログインするように促されますが、下部の「No thanks,just start my download」をクリックすればログインせずに続行できます。

3.ダウンロードしたインストーラを使用してODBCのインストールを行います。

4.セットアップタイプはComplateでいいかなと思います。（Customを選んでも結局ODBCしかインストールするものがないので、どれを選んでも同じかと思います。）

5.Windowsロゴ横の検索窓に「ODBC」と入力すると、ODBCデータソースがヒットするので、使用しているExcelと同じビット数のほうを開きます。(64Bit版Excelであれば64Bitのほうを開く)

6.追加をクリックします。

7.MySQL ODBC Unicode Driverを選択します。

8.DBの接続情報を入力してOKボタンをクリックします。ここでData Source Name設定した名前は、後で使うので控えておきます。

これでODBC接続の準備は完了となります。

VBAでデータベースのテーブル一覧を取得する

ODBCの準備ができたので、早速VBAからデータベースに接続していきたいと思います。

下準備として、VBEのツール→参照設定から「Microsoft ActiveX Data Object 6.1 Library」にチェックを入れます。

まずは、SQLを呼び出すための関数を作成しました。

Function execute_sql(sql As String) As ADODB.Recordset
    'ODBCで作成したDNS名を使用してMySQLに接続する
    Dim cn As New ADODB.Connection
    cn.ConnectionString = "Provider=MSDASQL;DSN=MySQL;"
    cn.Open

    '引数で渡されたSQLを実行する
    Dim rs As New ADODB.Recordset
    rs.Open sql, cn
    Set execute_sql = rs
End Function

ODBCで作成した「MySQL」という接続情報を使用してデータベースに接続し、引数で渡されたSQLを実行します。

戻り値として結果のレコードセットを返します。

※作法にのっとればADODB.Connectionを閉じる必要があるのですが、関数終了時にどうせ閉じられるので、特に対応していません。

Google検索するとデータベース接続は、CreateObjectでADODBのオブジェクトを作成するコードが多いですが、やはりインテリセンスが使えるようになるのでNewしたほうが良いと思います。

次に、この上記関数を使用してテーブルの一覧を取得する関数を作成します。

Function execute_sql(sql As String) As ADODB.Recordset
    'ODBCで作成したDNS名を使用してMySQLに接続する
    Dim cn As New ADODB.Connection
    cn.ConnectionString = "Provider=MSDASQL;DSN=MySQL;"
    cn.Open

    '引数で渡されたSQLを実行する
    Dim rs As New ADODB.Recordset
    rs.Open sql, cn
    Set execute_sql = rs
End Function

Sub get_table_names()
    Dim sql As String
    
    'テーブルの一覧を取得するSQL
    sql = " SELECT table_name, table_comment"
    sql = sql + " FROM information_schema.tables"
    sql = sql + " WHERE table_schema = database();"

    'SQLの実行結果を取得する
    Dim rs As ADODB.Recordset
    Set rs = execute_sql(sql)
    
    'Sheet1に結果を書き出す
    Dim sh As Worksheet
    Set sh = ThisWorkbook.Worksheets("Sheet1")
    sh.Cells.Clear
    
    'データベースから取得したカラムの名称を1行目に書き出す
    Dim col As Long
    Dim row As Long
    row = 1
    For col = 1 To rs.Fields.Count
        sh.Cells(row, col).Value = rs.Fields(col - 1).Name
        sh.Cells(row, col).Font.Bold = True
    Next col
    row = row + 1
    
    'データベースから取得した値を2行目以降に書き出す
    Do Until rs.EOF
        For col = 1 To rs.Fields.Count
            sh.Cells(row, col).Value = rs.Fields(col - 1).Value
        Next col
        row = row + 1
        rs.MoveNext
    Loop
    
End Sub

このget_table_namesを実行すると、以下のようにデータベースからテーブルの一覧を取得して記載してくれるので、テーブル定義書の目次とかにします。

テーブルのカラム一覧を作成する

データベースからテーブルの一覧は作成できたので、次に個別のテーブルの定義を作成します。

テーブルの定義取得用に以下の関数を作成しました。

Function execute_sql(sql As String) As ADODB.Recordset
    'ODBCで作成したDNS名を使用してMySQLに接続する
    Dim cn As New ADODB.Connection
    cn.ConnectionString = "Provider=MSDASQL;DSN=MySQL;"
    cn.Open

    '引数で渡されたSQLを実行する
    Dim rs As New ADODB.Recordset
    rs.Open sql, cn
    Set execute_sql = rs
End Function

Sub get_table_columns()
    '取得対象のテーブル名
    Const TABLE_NAME As String = "django_admin_log"

    'テーブル定義を書き出すシートを作成する（対象テーブル名で作成）
    Dim sh As Worksheet
    Set sh = create_WorkSheet(TABLE_NAME)
    
    'カラムの一覧を取得するSQL
    Dim sql As String
    sql = " select * from INFORMATION_SCHEMA.COLUMNS "
    sql = sql & "where TABLE_SCHEMA = database() and TABLE_NAME = '" & TABLE_NAME & "'"
    
    'SQLの実行結果を取得する
    Dim rs As ADODB.Recordset
    Set rs = execute_sql(sql)
    
    'データベースから取得したカラムの名称を1行目に書き出す
    Dim col As Long
    Dim row As Long
    row = 1
    For col = 1 To rs.Fields.Count
        sh.Cells(row, col).Value = rs.Fields(col - 1).Name
        sh.Cells(row, col).Font.Bold = True
    Next col
    row = row + 1
    
    'データベースから取得した値を2行目以降に書き出す
    Do Until rs.EOF
        For col = 1 To rs.Fields.Count
            sh.Cells(row, col).Value = rs.Fields(col - 1).Value
        Next col
        row = row + 1
        rs.MoveNext
    Loop
    
End Sub

'引数で渡したシート名のワークシートを新規に作成する。（既に存在すればそのシートを返す）
Function create_WorkSheet(sheet_name As String) As Worksheet
    On Error GoTo errProc
        Set create_WorkSheet = ThisWorkbook.Worksheets(sheet_name)
    Exit Function
    
errProc:
    Err.Clear
    Set create_WorkSheet = ThisWorkbook.Worksheets.Add()
    create_WorkSheet.Name = sheet_name
End Function

Const TABLE_NAMEの定数で定義したテーブル名のカラム一覧を作成します。結果は以下のようになります。

メタ情報を含めてカラムのデータをごっそり取得することができます。

よく使いそうなカラムだけに限定するなら、物理名、論理名、カラムの種類、デフォルト、プライマリキー、NOT NULLくらいですかね。

select文でカラムを指定してあげればよいです。

Function execute_sql(sql As String) As ADODB.Recordset
    'ODBCで作成したDNS名を使用してMySQLに接続する
    Dim cn As New ADODB.Connection
    cn.ConnectionString = "Provider=MSDASQL;DSN=MySQL;"
    cn.Open

    '引数で渡されたSQLを実行する
    Dim rs As New ADODB.Recordset
    rs.Open sql, cn
    Set execute_sql = rs
End Function



Sub get_table_columns()
    '取得対象のテーブル名
    Const TABLE_NAME As String = "django_admin_log"

    'テーブル定義を書き出すシートを作成する（対象テーブル名で作成）
    Dim sh As Worksheet
    Set sh = create_WorkSheet(TABLE_NAME)
    
    'カラムの一覧を取得するSQL
    Dim sql As String
    sql = " select COLUMN_NAME,DATA_TYPE,COLUMN_TYPE,COLUMN_COMMENT,COLUMN_DEFAULT,IS_NULLABLE,COLUMN_KEY from INFORMATION_SCHEMA.COLUMNS "
    sql = sql & "where TABLE_SCHEMA = database() and TABLE_NAME = '" & TABLE_NAME & "'"
    
    'SQLの実行結果を取得する
    Dim rs As ADODB.Recordset
    Set rs = execute_sql(sql)
    
    'データベースから取得したカラムの名称を1行目に書き出す
    Dim col As Long
    Dim row As Long
    row = 1
    For col = 1 To rs.Fields.Count
        sh.Cells(row, col).Value = rs.Fields(col - 1).Name
        sh.Cells(row, col).Font.Bold = True
    Next col
    row = row + 1
    
    'データベースから取得した値を2行目以降に書き出す
    Do Until rs.EOF
        For col = 1 To rs.Fields.Count
            sh.Cells(row, col).Value = rs.Fields(col - 1).Value
        Next col
        row = row + 1
        rs.MoveNext
    Loop
    
End Sub

'引数で渡したシート名のワークシートを新規に作成する。（既に存在すればそのシートを返す）
Function create_WorkSheet(sheet_name As String) As Worksheet
    On Error GoTo errProc
        Set create_WorkSheet = ThisWorkbook.Worksheets(sheet_name)
    Exit Function
    
errProc:
    Err.Clear
    Set create_WorkSheet = ThisWorkbook.Worksheets.Add()
    create_WorkSheet.Name = sheet_name
End Function

結果