■ はじめに
* 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