【Excel VBA】 Excel マクロ ~ SQL文を生成できるようにする ~

■ はじめに

 * Excelから、SQLデータ作成(INSERT文)を
   できる簡易ツールを作ってみる

 ■ 簡易仕様

 * シート名を「テーブル名」、ファイル名を「テーブル名.sql」
 * 1行目(ヨコ列)は、項目名で、2行目以降は、データ
 * 1列目(タテ列)がIDだと想定して、
    その列にデータがなかったら、データ作成を終了
 * 数字以外がきたら「'」で囲うようにする

 ■  サンプル

Sub ボタン1_Click()
    ' 定数
    Const MaxRow As Integer = 5000
    Const MaxColumn As Integer = 5000
    
    Dim sheet As Worksheet
    Dim tableName As String
    Dim fileName As String
    Dim sql As String
    Dim i As Integer
    Dim j As Integer
    
    For Each sheet In Worksheets
        ' シート名
        tableName = sheet.Name
        fileName = tableName & ".sql"
        
        sql = "INSERT INTO " & tableName & " ("
        
        ' 項目数
        Dim itemNumber As Integer: itemNumber = 0
        
        ' テーブルの項目を定義
        For i = 1 To MaxRow
            If IsEmpty(sheet.Cells(1, i).Value) = True Then
                ' 値がない時は処理を中断
                Exit For
            End If
            
            itemNumber = itemNumber + 1
            If i <> 1 Then
                sql = sql & ", "
            End If
            sql = sql & sheet.Cells(1, i).Value
        Next
        
        If itemNumber = 0 Then
            ' 項目数が0なら、次のシートへ
            sql = ""
            GoTo Continue
        End If
        
        sql = sql & ") VALUES ("
        
        ' テーブルの項目を定義
        ' 項目数
        Dim hasData As Boolean: hasData = False
        For i = 2 To MaxColumn
            If IsEmpty(sheet.Cells(i, 1).Value) = True Then
                If hasData = False Then
                    sql = ""
                    GoTo Continue
                Else
                    ' 初めに値がない時は処理を中断
                    Exit For
                End If
            End If
            
            hasData = True
            If i <> 2 Then
                sql = sql & ", ("
            End If
            
            For j = 1 To itemNumber
                If j <> 1 Then
                    sql = sql & ", "
                End If
                
                If IsEmpty(sheet.Cells(i, j).Value) = False And _
                IsNumeric(sheet.Cells(i, j).Value) = True Then
                    sql = sql & sheet.Cells(i, j).Value
                Else
                    sql = sql & "'" & sheet.Cells(i, j).Value & "'"
                End If
            Next
            sql = sql & ")"
        Next
        
        sql = sql & ";"
        
        If SaveFileWithUtf8(sql, fileName) = False Then
            MsgBox "ファイルの作成に失敗しました", vbCritical & vbOKOnly, "エラー"
        End If
Continue:
    Next
End Sub

Public Function SaveFileWithUtf8(ByVal inputData As String, ByVal fileName As String) As Boolean
On Error GoTo ErrorHandler
    Dim isSuccessful As Boolean: isSuccessful = False
    
    ' 定数
    Const AdodbTypeBinary As Integer = 1
    Const AdodbTypeText As Integer = 2
    Const AdodbSaveCreateOverWrite As Integer = 2
    Const FileCharset As String = "UTF-8"
    
    ' ADODB.Streamを作成
    Dim sourceOfDataStream: Set sourceOfDataStream = CreateObject("ADODB.Stream")
    ' 最初はテキストモードでUTF-8で書き込む
    sourceOfDataStream.Type = AdodbTypeText
    sourceOfDataStream.Charset = FileCharset
    sourceOfDataStream.Open
    
    ' ファイルに書き込み
    sourceOfDataStream.WriteText (inputData), 1
    
    ' バイナリモードにするためにPositionを0に戻す
    ' Readするためにはバイナリタイプでないといけない
    sourceOfDataStream.Position = 0
    sourceOfDataStream.Type = AdodbTypeBinary
    ' Positionを3にしてから読み込むことで最初の3バイトをスキップする
    ' UTF-8(BOMあり)のBOMをスキップします
    sourceOfDataStream.Position = 3
    Dim binaryOutputData: binaryOutputData = sourceOfDataStream.Read()
    
    ' 読み込んだバイナリデータをバイナリデータとしてファイルに出力する
    Dim outputStream: Set outputStream = CreateObject("ADODB.Stream")
    outputStream.Type = AdodbTypeBinary
    outputStream.Open
    outputStream.Write (binaryOutputData)
    outputStream.SaveToFile fileName, AdodbSaveCreateOverWrite
    
    isSuccessful = True
    GoTo Finally
ErrorHandler:
    MsgBox Err.Number & ":" & Err.Description, vbCritical & vbOKOnly, "エラー"
    isSuccessful = False
Finally:
    'ストリームの後始末
    If Not outputStream Is Nothing Then
        outputStream.Close
    End If
    If Not sourceOfDataStream Is Nothing Then
        sourceOfDataStream.Close
    End If
    
    SaveFileWithUtf8 = isSuccessful
End Function

 補足

 * 「Function SaveFileWithUtf8」は、以下の関連記事とほぼ同じ

https://dk521123.hatenablog.com/entry/2015/07/17/195527

 入力データ : シート「Person」

id   name    age
1   mike    23
2   Tom 32

 出力結果 : Person.sql

INSERT INTO Person (id, name, age) VALUES (1, 'mike', 23), (2, 'Tom', 32);

 関連記事

Excel マクロ ~ 入門編 ~
https://dk521123.hatenablog.com/entry/2015/07/15/104500
Excel マクロ ~ ファイル出力 / UTF-8
https://dk521123.hatenablog.com/entry/2015/07/17/195527