VBAでテストデータ作成

業務上テストデータが多々必要になりますが、
ツールをDLできないことが多いため、エクセルからシンプルにInsertを発行するVBAを記載します。

何処かにボタンを配置。
定数定義部の位置に物理名等記載
シートごとにSQLファイルが生成（UTF　BOMなし）

バグ等あると思いますが、ご了承下さい。
※MySqlをターゲットにしていますが、ほとんど変わらないと思います。

'定数宣言
Private Const INSERT As String = "insert into "
Private Const VALUES As String = ") values ("
Private Const INSERT_END As String = " );"
Private Const SQL_EXTENSION As String = ".sql"
Private Const START_LINE As Integer = 6
Private Const START_COLUMN As Integer = 2
Private Const PHYSICAL_LINE As Integer = 3
Private Const TYPE_LINE As Integer = 4

'insert作る
Sub Insert作成ボタン()
    Dim mySheet As Worksheet
    Dim myRow As Long

    myRow = 1
    
    For Each mySheet In Worksheets
        If mySheet.Name = "top" Then GoTo Next_i
        Call outputCsv(mySheet)
Next_i:
    Next
End Sub

Sub outputCsv(mySheet As Worksheet)
    With mySheet.UsedRange
        MaxRow = .Rows(.Rows.Count).row
        MaxCol = .Columns(.Columns.Count).Column
    End With
    
    Dim currentLine As Integer
    Dim outputDir As String
    Dim schema As String
    
    currentLine = START_LINE
    'スキーマと出力フォルダ
    schema = Worksheets("top").Cells(1, 2).Value
    outputDir = Worksheets("top").Cells(2, 2).Value
    
    'ファイル出力準備(UTF-8)
    Dim output As ADODB.Stream
    Set output = New ADODB.Stream

    output.Type = adTypeText
    output.Charset = "UTF-8"
    output.Open

    
    Do While currentLine <= MaxRow
        If mySheet.Cells(currentLine, 1).Value = "" Then GoTo Next_Loop
        Dim buf As String
        buf = ""
        Dim currentColumn As Integer
        currentColumn = START_COLUMN
        Dim columnCount As Integer
        
        Do While mySheet.Cells(PHYSICAL_LINE, currentColumn).Value <> ""
            If currentColumn = START_COLUMN Then
                buf = INSERT & schema & "." & mySheet.Cells(1, 2).Value & " (" & mySheet.Cells(PHYSICAL_LINE, currentColumn).Value
            Else
                buf = buf & ", " & mySheet.Cells(PHYSICAL_LINE, currentColumn)
            End If
            currentColumn = currentColumn + 1
            columnCount = currentColumn
        Loop
        buf = buf & VALUES
        currentColumn = START_COLUMN
        
        Do While currentColumn < columnCount
            If currentColumn = START_COLUMN Then
                buf = buf & mapping(mySheet.Cells(currentLine, currentColumn).Value, mySheet.Cells(TYPE_LINE, currentColumn).Value)
            Else
                buf = buf & ", " & mapping(mySheet.Cells(currentLine, currentColumn).Value, mySheet.Cells(TYPE_LINE, currentColumn).Value)
            End If
            currentColumn = currentColumn + 1
        Loop
        buf = buf & INSERT_END & vbLf
        
        output.WriteText buf

  
        currentLine = currentLine + 1
Next_Loop:
    Loop
    
    Dim filename As String
    filename = ActiveWorkbook.Path & "\" & mySheet.Cells(1, 2).Value & SQL_EXTENSION
    
    '保存前にBOMを削除
    Dim byteData() As Byte
    output.Position = 0
    output.Type = adTypeBinary
    output.Position = 3
    byteData = output.Read
    output.Close
    output.Open
    output.Write byteData

    output.SaveToFile filename, adSaveCreateOverWrite
    output.Close
    Set output = Nothing
End Sub

Function mapping(word As String, kind As String) As String
    If LCase(kind) = "string" Or LCase(kind) = "varchar" Or LCase(kind) = "varchar2" Or LCase(kind) = "char" Then
        mapping = """" & word & """"
    ElseIf LCase(kind) = "int" Or LCase(kind) = "bigint" Then
        mapping = word
    ElseIf LCase(kind) = "datetime" Then
        mapping = "STR_TO_DATE(" & word & ",""YYYYMMDD HH:MI:SS"")"
    Else
        MsgBox ("未定義のカラム名があります:" & kind)
        Application.Quit
    End If
End Function