vba-excel文件导出表中数据到sql文件

第一个sheet建立按钮CommandButton1，
第二个sheet问配置表，第一列为用户，第二列为表名，第三列为列名，第四列为属性
第三四。。个sheet为表的配置，第一行为列名，以下为列中的数据，（sheet名为“用户.表名”）

导出文件在当前目录，文件名为TestFile.sql

Public MyArray As Variant
Private Sub CommandButton1_Click()

    Dim gPath As String
    Dim sFile As Object, Fso As Object
    Dim ColInfo As Variant
    Dim iRow As Integer
    Dim iCol As Integer
    Dim Sqlstr As String

    gPath = Application.ActiveWorkbook.Path
    Set Fso = CreateObject("Scripting.FileSystemObject")
    Set sFile = Fso.CreateTextFile(gPath & "/TestFile.sql", True)

    MyArray = Sheets("配置表定义").UsedRange

    '循环sheet
    For Each Shnow In Worksheets
        collist = ""
        sFile.WriteBlankLines (1) '写入一个空白行
        'sheet名称包含"点"
        If InStr(1, Shnow.Name, ".") <> 0 Then
        '第一行的名称以及对应的属性
        MaxCol = Shnow.Range("A1").End(xlToRight).Column
        ReDim ColInfo(1 To 2, 1 To MaxCol)
        For iCol = 1 To Shnow.Range("A1").End(xlToRight).Column
            '取得列名
            ColInfo(1, iCol) = Shnow.Cells(1, iCol).Value
            collist = collist & "," & Shnow.Cells(1, iCol).Value
        Next iCol
        collist = "insert into " & Shnow.Name & "(" & Right(collist, Len(collist) - 1) & ") values"

        '从单元格A2开始读取数据，到数据表结尾，写入到文本文件中
        For iRow = 2 To Shnow.Range("A65536").End(xlUp).Row
        '第一列不为空时
        If Shnow.Cells(iRow, 1).Value <> "" Then
            Sqlstr = ""
            For iCol = LBound(ColInfo, 2) To UBound(ColInfo, 2) '从数组中读取数据并写入对应的单元格
                If Shnow.Cells(iRow, iCol).Value = "" Then
                    Sqlstr = Sqlstr & "," & "null"
                ElseIf Tab_attribute(Shnow.Name & "." & Shnow.Cells(1, iCol).Value) = "CHAR" Then
                    Sqlstr = Sqlstr & "," & "'" & Replace(Shnow.Cells(iRow, iCol).Value, "'", "''") & "'"
                ElseIf Tab_attribute(Shnow.Name & "." & Shnow.Cells(1, iCol).Value) = "NUMBER" Then
                    Sqlstr = Sqlstr & "," & Shnow.Cells(iRow, iCol).Value
                ElseIf Tab_attribute(Shnow.Name & "." & Shnow.Cells(1, iCol).Value) = "DATE" Then
'                    Sqlstr = Sqlstr & "," & "'" & Shnow.Cells(iRow, iCol).Value & "'"
                    Sqlstr = Sqlstr & "," & "to_date('" & CStr(Format(Shnow.Cells(iRow, iCol).Value, "yyyy-mm-dd hh:nn:ss")) & "','yyyy-mm-dd hh24:mi:ss')"

                End If

            Next iCol
            Sqlstr = "(" & Right(Sqlstr, Len(Sqlstr) - 1) & ");"
            sFile.WriteLine (collist & Sqlstr)
        End If
        Next iRow

        End If

    Next

    sFile.WriteBlankLines (1) '写入一个空白行
    sFile.WriteLine ("commit;")
    sFile.Close
    Set sFile = Nothing
    Set Fso = Nothing

End Sub

Function Tab_attribute(User_Tab_Col As String) As String

    '第一行跳过
    For iRow = 2 To UBound(MyArray, 1)
        If UCase(Replace(MyArray(iRow, 1) & "." & MyArray(iRow, 2) & "." & MyArray(iRow, 3), " ", "")) = UCase(Replace(User_Tab_Col, " ", "")) Then
            If InStr(1, UCase(MyArray(iRow, 4)), "CHAR") <> 0 Then
                Tab_attribute = "CHAR"
            ElseIf InStr(1, UCase(MyArray(iRow, 4)), "DATE") <> 0 Then
                Tab_attribute = "DATE"
            Else
                Tab_attribute = "NUMBER"
            End If
            Exit For
        End If
    Next iRow

End Function