如何将Excel中表结构数据自动生成SQL脚本的方法（VB代码实现）

/************版权归本人所有，违者必究************/

一： 在本地PC新建一个Excel文件（例如：excel2007）

    准备工作，左键选择excel文本左上角的图标，选择“Excle选项”。1. 点击“信任中心”->“信任中心设置”->“宏设置”->选择“启用所有宏...”选项。“开发人员宏设置”选项也勾选上。  2. 点击“信任中心”->“信任中心设置”->选择“个人信息选项”，将“文档特定设置”上面默认选择去掉，避免在保存脚本时报错。

二： 在本地PC新建一个excel文件（例如： D:\testdate.xlsx）

    按快捷键“ALT + F11”进入宏编辑，输入如下代码后保存。summary()为目标生成代码，SQL()为生成SQL脚本文件代码，按条件生成SQL的脚本如下：

Sub summary()

  Dim i As Integer 
    i = 2  
    ThisWorkbook.Worksheets(1).Columns(2).Clear

    For Each sh In ThisWorkbook.Worksheets

    If sh.Name <> "   " Then

    ThisWorkbook.Worksheets(1).Cells(i, 2).Value = sh.Name
    ThisWorkbook.Worksheets(1).Cells(i, 2).Select
    ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:= _
    sh.Name + "!A1", TextToDisplay:=sh.Name
    i = i + 1
    End If
    Next sh
    
    ThisWorkbook.Worksheets(1).Cells.Select
   
    With Selection.Font
        .Name = "目录"
        .Size = 9
        .Strikethrough = False
        .Superscript. = False
        .Subscript. = False
        .OutlineFont = False
        .Shadow = False
        .TintAndShade = 0
        .ThemeFont = xlThemeFontNone
    End With
End Sub

Sub SQL()
   Dim i As Integer
    i = 1
    Dim ADO_Stream As Object
    Dim strSQL, strDelSQL As String
    Dim strTblName As String
    Dim col As Long
    Dim row As Long
    Dim str As String
    Dim PK As String
    Dim cnt As Integer
       
    PK = "PK"    
    Dim rowcounts As Long
    rowcounts = 0
    Dim filecount As Long
    filecount = 0 
    Set ADO_Stream = CreateObject("ADODB.Stream")
    ADO_Stream.Type = 2
    ADO_Stream.Mode = 3
    ADO_Stream.Charset = "unicode"
    ADO_Stream.Open
   
    Dim checkType As String 
        For Each sh In ThisWorkbook.Worksheets    
            cnt = 0

            If sh.Name <> "   " And InStr(sh.Name, "template") = 0 Then
                strTblName = sh.Cells(1, 2).Value
                rowcounts = 1
                'Insert SQL
                row = 6
               
                Do While sh.Cells(row, 1).Value <> ""  
                    strDelSQL = "delete from " + strTblName + " where "
                    strSQL = "Insert into " + strTblName + " ("
                    col = 1
                    Do While sh.Cells(3, col).Value <> ""    
                        If col <> 1 Then
                            strSQL = strSQL + ", "
                        End If
                        strSQL = strSQL + sh.Cells(3, col).Value
                        col = col + 1
                    Loop
                    strSQL = strSQL + ") VALUES ("
                    col = 1
                    Do While sh.Cells(3, col).Value <> ""
                           
                        str = Trim(CStr(sh.Cells(row, col).Value))
                       
                        If InStr(Trim(CStr(sh.Cells(2, col).Value)), PK) <> 0 Then
                            If cnt > 0 Then
                                strDelSQL = strDelSQL + " and "
                            End If
                            strDelSQL = strDelSQL + Trim(CStr(sh.Cells(3, col).Value)) + " = '" + str + "'"
                            cnt = cnt + 1
                        End If             
                        If col <> 1 Then
                            strSQL = strSQL + ", "
                        End If
                       
                        If (InStr(Trim(CStr(sh.Cells(4, col).Value)), "Integer") = 0) And (InStr(Trim(CStr(sh.Cells(4, col).Value)), "Decimal") = 0) And ((InStr(Trim(CStr(sh.Cells(4, col).Value)), "DATE") = 0) Or _
                        ((Len(str) > 0) And (InStr(Trim(CStr(sh.Cells(4, col).Value)), "DATE") > 0))) Then
                            If (Len(str) <= 0) And (InStr(Trim(CStr(sh.Cells(5, col).Value)), "No") = 0) Then
                                str = "NULL"
                            ElseIf InStr(Trim(CStr(sh.Cells(4, col).Value)), "DATE") > 0 Then
                                str = "to_date('" + str + "','yyyy-mm-dd hh24:mi:ss')"
                            Else
                                str = "'" + str + "'"
                            End If
                       
                            strSQL = strSQL + str
                        ElseIf (Len(str) <= 0) And (InStr(Trim(CStr(sh.Cells(4, col).Value)), "DATE") > 0) Then
                            strSQL = strSQL + "NULL"
                        Else
                            If (Len(str) <= 0) And (InStr(Trim(CStr(sh.Cells(5, col).Value)), "No") = 0) Then
                                str = "NULL"
                            End If
                       
                            strSQL = strSQL + str
                        End If
                       
                        col = col + 1
                    Loop
                   
                    strDelSQL = strDelSQL + ";" + vbCrLf
                    ADO_Stream.WriteText strDelSQL
                    strSQL = strSQL + ");" + vbCrLf
                    ADO_Stream.WriteText strSQL
                    row = row + 1            
                Loop
           End If
            i = i + 1            
            rowcounts = 0
            filecount = 0          
        Next sh
        ADO_Stream.SaveToFile ThisWorkbook.Path & "\MstSQL(delete by condition).txt", 2
        ADO_Stream.Close
        Set ADO_Stream = Nothing     
End Sub

点击“保存”宏脚本，主要的一步完成。

三： 在excel文件（test.xlsx）的首页创建两个图标，分别选择右键指定宏，一个指定上面的summary(),一个指定上面的SQL()。然后就可以在后续的sheet页创建自己需要生成SQL脚本的表结构名称了，记得每个sheet页面对应一个表结构及数据，使用方法如下：

A,将需要更新的对象表数据整个sheet拷进工具中，数据只保留需要更新的数据。
B,在第2行标出主键字段，填上“PK”即可。
C,点击生成SQL。

注意点：删除对象的表顺序必须自行调整，子表在前，主表在后。

举例如下：

第一行：M_Owner
第二行：PK 
第三行：OWNER_ID     OWNER_CODE
第四行：NUMBER(18,0) VARCHAR2(10 BYTE)
第五行：No                Yes
数据行：900000000000000001 TTE
数据行：900000000000000002 TTAP

备注： 不按条件生成的VB代码如下，同上面的代码略有不同，功能是一样的

Sub summary()

   Dim i As Integer  
    i = 2   
    ThisWorkbook.Worksheets(1).Columns(2).Clear
    For Each Sh In ThisWorkbook.Worksheets
    If Sh.Name <> "" Then
    ThisWorkbook.Worksheets(1).Cells(i, 2).Value = Sh.Name   
    ThisWorkbook.Worksheets(1).Cells(i, 2).Select
    ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:= _
    Sh.Name + "!A1", TextToDisplay:=Sh.Name  
    i = i + 1   
    End If   
    Next Sh
    
    ThisWorkbook.Worksheets(1).Cells.Select 
    With Selection.Font
        .Name = "目次"
        .Size = 9
        .Strikethrough = False
        .Superscript. = False
        .Subscript. = False
        .OutlineFont = False
        .Shadow = False
        .TintAndShade = 0
        .ThemeFont = xlThemeFontNone
    End With
 
End Sub

Sub SQL()
   Dim i As Integer 
    i = 1 
    Dim ADO_Stream As Object
    Dim strSQL As String
    Dim strTblName As String
    Dim col As Long
    Dim row As Long
    Dim str As String   
    Dim rowcounts As Long
    rowcounts = 0   
    Dim filecount As Long
    filecount = 0
   
    Set ADO_Stream = CreateObject("ADODB.Stream")
    ADO_Stream.Type = 2
    ADO_Stream.Mode = 3
    ADO_Stream.Charset = "unicode"
    ADO_Stream.Open
   
    Dim checkType As String  
    checkType = InputBox("1:将所有表生成到一个SQL文件" & vbCrLf & "2:单独按表生成SQL文件") 
    If Trim(checkType) = "1" Then 
        For Each Sh In ThisWorkbook.Worksheets        
            If Sh.Name <> "" And InStr(Sh.Name, "template") = 0 Then          
                strTblName = Sh.Cells(1, 2).Value           
                'Delete SQL
                strSQL = "Delete from " + strTblName + ";" + vbCrLf + strSQL              
            End If
        Next Sh          
        ADO_Stream.WriteText strSQL  
        For Each Sh In ThisWorkbook.Worksheets
           If Sh.Name <> "" And InStr(Sh.Name, "template") = 0 Then         
                strTblName = Sh.Cells(1, 2).Value                       
                rowcounts = 1              
                'Insert SQL      
                row = 6             
                Do While Sh.Cells(row, 1).Value <> ""               
                    strSQL = "Insert into " + strTblName + " ("                   
                    col = 1
                    Do While Sh.Cells(3, col).Value <> ""                      
                        If col <> 1 Then
                            strSQL = strSQL + ", "
                       End If                       
                        strSQL = strSQL + Sh.Cells(3, col).Value
                   
                        col = col + 1
                    Loop                   
                    strSQL = strSQL + ") VALUES ("                  
                    col = 1                  
                    Do While Sh.Cells(3, col).Value <> ""                 
                        If col <> 1 Then
                            strSQL = strSQL + ", "
                        End If
                       
                        str = Trim(CStr(Sh.Cells(row, col).Value))
                       
                        If (InStr(Trim(CStr(Sh.Cells(4, col).Value)), "Integer") = 0) And (InStr(Trim(CStr(Sh.Cells(4, col).Value)), "Decimal") = 0) And ((InStr(Trim(CStr(Sh.Cells(4, col).Value)), "DATE") = 0) Or _
                        ((Len(str) > 0) And (InStr(Trim(CStr(Sh.Cells(4, col).Value)), "DATE") > 0))) Then
                            If (Len(str) <= 0) And (InStr(Trim(CStr(Sh.Cells(5, col).Value)), "No") = 0) Then
                                str = "NULL"
                            ElseIf InStr(Trim(CStr(Sh.Cells(4, col).Value)), "DATE") > 0 Then
                                str = "to_date('" + str + "','yyyy-mm-dd hh24:mi:ss')"
                            Else
                                str = "'" + str + "'"
                            End If
                       
                            strSQL = strSQL + str
                        ElseIf (Len(str) <= 0) And (InStr(Trim(CStr(Sh.Cells(4, col).Value)), "DATE") > 0) Then
                            strSQL = strSQL + "NULL"
                        Else
                            If (Len(str) <= 0) And (InStr(Trim(CStr(Sh.Cells(5, col).Value)), "No") = 0) Then
                                str = "NULL"
                            End If
                       
                            strSQL = strSQL + str
                        End If
                       
                        col = col + 1
                    Loop
               
                    strSQL = strSQL + ");" + vbCrLf                   
                    ADO_Stream.WriteText strSQL
                    row = row + 1
                               
                Loop              
           End If
           
            i = i + 1
                   
                'ADO_Stream.SaveToFile ThisWorkbook.Path & "\SQL\" + sh.Name + ".txt", 2
                'ADO_Stream.Close
                'ADO_Stream.Open
           
            rowcounts = 0
            filecount = 0
           
        Next Sh
        ADO_Stream.SaveToFile ThisWorkbook.Path & "\MstSQL.txt", 2
        ADO_Stream.Close
        Set ADO_Stream = Nothing
       
    ElseIf Trim(checkType) = "2" Then       
        For Each Sh In ThisWorkbook.Worksheets
           If Sh.Name <> "" And InStr(Sh.Name, "template") = 0 Then         
                strTblName = Sh.Cells(1, 2).Value         
                'Delete SQL
                strSQL = "Delete from " + strTblName + ";" + vbCrLf
                ADO_Stream.WriteText strSQL
                rowcounts = 1              
                'Insert SQL     
                row = 6              
                Do While Sh.Cells(row, 1).Value <> ""              
                    strSQL = "Insert into " + strTblName + " VALUES ("                  
                    col = 1                  
                    Do While Sh.Cells(3, col).Value <> ""                  
                        If col <> 1 Then
                            strSQL = strSQL + ", "
                        End If                       
                        str = Trim(CStr(Sh.Cells(row, col).Value))                       
                        If (InStr(Trim(CStr(Sh.Cells(4, col).Value)), "Integer") = 0) And (InStr(Trim(CStr(Sh.Cells(4, col).Value)), "Decimal") = 0) And ((InStr(Trim(CStr(Sh.Cells(4, col).Value)), "DATE") = 0) Or _
                        ((Len(str) > 0) And (InStr(Trim(CStr(Sh.Cells(4, col).Value)), "DATE") > 0))) Then
                            If (Len(str) <= 0) And (InStr(Trim(CStr(Sh.Cells(5, col).Value)), "N") = 0) Then
                                str = "NULL"
                            ElseIf InStr(Trim(CStr(Sh.Cells(4, col).Value)), "DATE") > 0 Then
                                str = "to_date('" + str + "','yyyy-mm-dd hh24:mi:ss')"
                            Else
                                str = "'" + str + "'"
                            End If                      
                            strSQL = strSQL + str
                        ElseIf (Len(str) <= 0) And (InStr(Trim(CStr(Sh.Cells(4, col).Value)), "DATE") > 0) Then
                            strSQL = strSQL + "NULL"
                        Else
                            If (Len(str) <= 0) And (InStr(Trim(CStr(Sh.Cells(5, col).Value)), "N") = 0) Then
                                str = "NULL"
                            End If                       
                            strSQL = strSQL + str
                        End If                       
                        col = col + 1
                    Loop              
                    strSQL = strSQL + ");" + vbCrLf                   
                    ADO_Stream.WriteText strSQL             
                    row = row + 1                   
           
                Loop       
                ADO_Stream.SaveToFile ThisWorkbook.Path & "\" + Sh.Name + ".txt", 2
                ADO_Stream.Close
                ADO_Stream.Open              
           End If           
            i = i + 1           
            rowcounts = 0
            filecount = 0           
        Next Sh       
        ADO_Stream.Close
        Set ADO_Stream = Nothing   
    Else       
        MsgBox "请输入选择项！"
        ADO_Stream.Close
           
    End If
End Sub