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