ORACLE用INSERT文生成Excelマクロ

テストデータ作るときにあると便利なので、
VBAの復習も兼ねて自作してみました。
Excelがあればどこでも動くはず。
●Excelシート構成

1.Mainシート
B2セル：スキーマ名
B3セル：テーブル名
B4セル：出力先シート名
B5~XFD5セル：DB項目名
B6~XFD6セル：データ型(文字列、NUMBER、日付、TIMESTAMPのみ)
B7~XFD1048576セル：登録するデータ
2.結果出力シート
MainシートB4セルで指定したシート名でシートを作る
●VBA内容

Option Base 1
Option Explicit
'***********************
'*Main処理
'***********************
Sub main()
    Dim scmName As String
    Dim tblName As String
    Dim tblClmName As Variant
    Dim dataType As Variant
    Dim dataVal As Variant
    Dim clmLen As Long
    Dim valRowLen As Long
    Dim head As String
    Dim sql() As String
    Dim i, j As Long
    Dim typeErr As Long
    Dim strTblClmName As String
    Dim strDataType As String
    Dim strDataVal As String


    typeErr = 0

    'スキーマ名を取得する
    scmName = getSchName()

    'テーブル名を取得する
    tblName = getTblName

    '対象項目の項目名を配列で取得する
    tblClmName = getTblClmName
    clmLen = UBound(tblClmName, 2)

    '対象項目のデータ型を配列で取得する
    dataType = getDataType

    '対象項目のデータを配列で取得する
    dataVal = getDataVal
    valRowLen = UBound(dataVal, 1)

    'SQL文を作成する
    ReDim sql(valRowLen)

    head = "INSERT INTO " + scmName + "." + tblName + "("
    For i = 1 To clmLen
        If i <> 1 Then
            head = head + ", "
        End If
        head = head + tblClmName(1, i)
    Next
    head = head + ")"

    For i = 1 To valRowLen
        sql(i) = head + " values ("
        For j = 1 To clmLen
            If j <> 1 Then
                sql(i) = sql(i) + ", "
            End If

            If IsEmpty(dataType(1, j)) Then
                strDataType = ""
            Else
                strDataType = dataType(1, j)
            End If
            If IsEmpty(dataVal(i, j)) Then
                strDataVal = ""
            Else
                strDataVal = dataVal(i, j)
            End If

            Select Case True
                Case strDataType Like "*CHAR*"
                    sql(i) = sql(i) + "'" + strDataVal + "' "
                Case strDataType Like "*NUMBER*"
                    If Trim(strDataVal) = "" Then
                        sql(i) = sql(i) + "NULL"
                    Else
                        sql(i) = sql(i) + strDataVal + " "
                    End If
                Case strDataType = "TIMESTAMP"
                    If Trim(strDataVal) = "SYSTIMESTAMP" Then
                        sql(i) = sql(i) + "SYSTIMESTAMP"
                    ElseIf strDataVal <> "" Then
                        sql(i) = sql(i) + "TO_TIMESTAMP('" + strDataVal + "','" + getTimeStampFormat + "')"
                    Else
                        sql(i) = sql(i) + "NULL"
                    End If
                Case strDataType = "DATE"
                    If Trim(strDataVal) = "SYSDATE" Then
                        sql(i) = sql(i) + "SYSDATE"
                    ElseIf Trim(strDataVal) <> "" Then
                        sql(i) = sql(i) + "TO_DATE('" + strDataVal + "','" + getDateFormat + "')"
                    Else
                        sql(i) = sql(i) + "NULL"
                    End If
                Case Else
                    typeErr = -1
            End Select


        Next
        sql(i) = sql(i) + ");"
    Next

    '作成したSQLを結果を出力する
    Dim ws As Worksheet
    Dim wsRst As Worksheet
    Dim outebleflg As Long
    outebleflg = 0
    For Each ws In Sheets
        If ws.name = ThisWorkbook.ActiveSheet.Range("B4").Value Then
            outebleflg = 1
        End If
    Next
    If outebleflg = 1 Then
        Set ws = ThisWorkbook.ActiveSheet
        Set wsRst = ThisWorkbook.Sheets(ws.Range("B4").Value)


        For i = 1 To UBound(sql)
            wsRst.Cells(i, 1).Value = sql(i)
        Next

        If typeErr = -1 Then
            MsgBox "データ型に不備有？問題なければ実行可能。"
        End If
    Else
        MsgBox "出力先シートがない"
    End If

End Sub

'***********************
'スキーマ取得用
'***********************
Function getSchName() As String
    Dim ws As Worksheet
    Set ws = ThisWorkbook.ActiveSheet
    getSchName = ws.Range("B2").Value

End Function

'***********************
'テーブル名取得用
'***********************
Function getTblName() As String
    Dim ws As Worksheet
    Set ws = ThisWorkbook.ActiveSheet
    getTblName = ws.Range("B3").Value

End Function

'***********************
'テーブル項目名取得用
'配列の要素番号は1始まり
'***********************
Function getTblClmName() As Variant
    Dim ws As Worksheet
    Set ws = ThisWorkbook.ActiveSheet
    Dim MaxCol As Long
    MaxCol = ws.UsedRange.Find("*", , xlFormulas, , xlByColumns, xlPrevious).Column
    With ws.UsedRange
        getTblClmName = .Range(.Cells(5, 2), .Cells(5, MaxCol))
    End With

End Function

'***********************
'データ型取得用
'***********************
Function getDataType() As Variant
    Dim ws As Worksheet
    Set ws = ThisWorkbook.ActiveSheet
    Dim MaxCol As Long
    MaxCol = ws.UsedRange.Find("*", , xlFormulas, , xlByColumns, xlPrevious).Column
    With ws.UsedRange
        getDataType = .Range(.Cells(6, 2), .Cells(6, MaxCol))
    End With

End Function

'***********************
'データ取得用
'***********************
Function getDataVal() As Variant
    Dim wb As Workbook
    Set wb = ThisWorkbook
    Dim ws As Worksheet
    Set ws = wb.ActiveSheet
    Dim UsRng  As Range
    Set UsRng = ws.UsedRange
    Dim MaxRow As Long
    Dim MaxCol As Long
    With UsRng
        MaxRow = .Find("*", , xlFormulas, , xlByRows, xlPrevious).row
        MaxCol = .Find("*", , xlFormulas, , xlByColumns, xlPrevious).Column
    End With
    With ws
        getDataVal = .Range(.Cells(7, 2), .Cells(MaxRow, MaxCol))
    End With


End Function


Function getDateFormat() As String
    getDateFormat = "YYYYMMDD"
End Function


Function getTimeStampFormat() As String
    getTimeStampFormat = "YYYYMMDDHH24MISS"
End Function