VBA 自动生成Sql

蔚落 2022-07-13 01:37 206阅读 0赞

Option Explicit  
Option Base 1  
Const KOUMOKU\_ROW = 3  
Const NO\_COL = 2

''' -----------------------------------------------------------------------------  
''' Project  : DUPLO  
'''  
''' -----------------------------------------------------------------------------  
''' <summary>  
'''  
''' </summary>  
''' <remarks>Insert\_SQL文処理(シート分)  
''' </remarks>  
''' <history>  
'''      2010/03/12  Created  
''' </history>  
''' -----------------------------------------------------------------------------  
Sub Sql\_Create(ByVal strTableName As String)

Dim sql         As String  
    Dim intFileNo       As Integer  
    Dim sqlfname       As String  
         
   ' テキストファイル命名方法: サブシステムコード + "0" + テーブルコード + "0" + .sql  
    sqlfname = strTableName & ".sql"  
   
    If sqlfname = "False" Then    ' <cancel> ボタンを選択した場合.  
        Exit Sub  
    End If  
    If all = 1 Then  
        sqlfname = Application.ActiveWorkbook.Path & "/all\_crate\_master.sql"  
    Else  
        sqlfname = Application.ActiveWorkbook.Path & "/" & strTableName & ".sql"  
    End If  
   
    If sqlfname = "False" Then     ' <cancel> ボタンを選択した場合.  
        Exit Sub  
    End If

If all = 1 Then  
        If g\_i = 1 Then  
            intFileNo = FreeFile  
            Open sqlfname For Output As \#intFileNo  
        Else  
            intFileNo = FreeFile  
            Open sqlfname For Append As \#intFileNo  
        End If  
    Else  
        intFileNo = FreeFile  
        Open sqlfname For Output As \#intFileNo  
    End If  
     
    Dim i As Integer  
    Dim mmcd\_kbn As String  
    Dim sysdate As Date  
    sysdate = Now()  
    i = KOUMOKU\_ROW  
     
    '--------Mメッセージ----------------  
      If strTableName = "m\_message" Then  
       
        '--------- delete recorder ------------------------------------------------------------------\*  
        sql = ""  
        sql = " DELETE FROM " & strTableName  
        Print \#intFileNo, sql  
        sql = "GO"  
        Print \#intFileNo, sql  
         
        sql = ""  
        '--------- read recorder ------------------------------------------------------------------\*  
         
         Do

mmcd\_kbn = ActiveSheet.Cells(i, NO\_COL)  
                 
          If mmcd\_kbn <> Empty Then  
           
            sql = " INSERT INTO " & strTableName  
            sql = sql & " ("  
            sql = sql & "message\_id,"  
            sql = sql & "message\_type,"  
            sql = sql & "message\_contents,"  
            sql = sql & "hint,"  
            sql = sql & "remark,"  
            sql = sql & "ins\_emp\_cd,"  
            sql = sql & "ins\_date,"  
            sql = sql & "upd\_emp\_cd,"  
            sql = sql & "upd\_date"  
            sql = sql & ")"  
            sql = sql & "VALUES"  
            sql = sql & " ("  
            sql = sql & "'" & ActiveSheet.Cells(i, 2) & "'" & ","  
             
            If ActiveSheet.Cells(i, 3) <> Empty Then  
            sql = sql & "'" & ActiveSheet.Cells(i, 3) & "'" & ","  
            Else  
            sql = sql & "'',"  
            End If  
             
            If ActiveSheet.Cells(i, 4) <> Empty Then  
            sql = sql & "'" & ActiveSheet.Cells(i, 4) & "'" & ","  
            Else  
            sql = sql & "'',"  
            End If  
             
            If ActiveSheet.Cells(i, 5) <> Empty Then  
            sql = sql & "'" & ActiveSheet.Cells(i, 5) & "'" & ","  
            Else  
            sql = sql & "NULL,"  
            End If  
             
            If ActiveSheet.Cells(i, 6) <> Empty Then  
            sql = sql & "'" & ActiveSheet.Cells(i, 6) & "'" & ","  
            Else  
            sql = sql & "NULL,"  
            End If  
             
            sql = sql & "'sys',"  
            sql = sql & "'" & sysdate & "'" & ","  
            sql = sql & "'sys',"  
            sql = sql & "'" & sysdate & "'"  
            sql = sql & ")"  
             
            Print \#intFileNo, sql  
             
          End If  
         
        If ActiveSheet.Cells(i, 2) = Empty Then  
           Exit Do  
        End If

i = i + 1  
    Loop  
    '--------M管理----------------  
    ElseIf strTableName = "m\_manage" Then  
     
        '--------- delete recorder ------------------------------------------------------------------\*  
    sql = ""  
    sql = " DELETE FROM " & strTableName  
    Print \#intFileNo, sql  
    sql = "GO"  
    Print \#intFileNo, sql  
     
    sql = ""  
    i = KOUMOKU\_ROW  
    '--------- read recorder ------------------------------------------------------------------\*  
     
    Do  
       
      mmcd\_kbn = ActiveSheet.Cells(i, NO\_COL)  
             
      If mmcd\_kbn <> Empty Then  
       
        sql = " INSERT INTO " & strTableName  
        sql = sql & " ("  
        sql = sql & "manage\_flg,"  
        sql = sql & "key1,"  
        sql = sql & "key2,"  
        sql = sql & "key3,"  
        sql = sql & "key4,"  
        sql = sql & "key5,"  
        sql = sql & "char1,"  
        sql = sql & "char2,"  
        sql = sql & "char3,"  
        sql = sql & "char4,"  
        sql = sql & "char5,"  
        sql = sql & "char6,"  
        sql = sql & "char7,"  
        sql = sql & "char8,"  
        sql = sql & "char9,"  
        sql = sql & "char10,"  
        sql = sql & "remark,"  
        sql = sql & "ins\_emp\_cd,"  
        sql = sql & "ins\_date,"  
        sql = sql & "upd\_emp\_cd,"  
        sql = sql & "upd\_date"  
        sql = sql & ")"  
        sql = sql & "VALUES"  
        sql = sql & " ("  
        sql = sql & "'" & ActiveSheet.Cells(i, 2) & "'" & ","  
        sql = sql & "'" & ActiveSheet.Cells(i, 3) & "'" & ","  
        sql = sql & "'" & ActiveSheet.Cells(i, 4) & "'" & ","  
        sql = sql & "'" & ActiveSheet.Cells(i, 5) & "'" & ","  
        sql = sql & "'" & ActiveSheet.Cells(i, 6) & "'" & ","  
        sql = sql & "'" & ActiveSheet.Cells(i, 7) & "'" & ","  
         
        If ActiveSheet.Cells(i, 8) <> Empty Then  
        sql = sql & "'" & ActiveSheet.Cells(i, 8) & "'" & ","  
        Else  
        sql = sql & "NULL,"  
        End If  
         
        If ActiveSheet.Cells(i, 9) <> Empty Then  
        sql = sql & "'" & ActiveSheet.Cells(i, 9) & "'" & ","  
        Else  
        sql = sql & "NULL,"  
        End If  
         
        If ActiveSheet.Cells(i, 10) <> Empty Then  
        sql = sql & "'" & ActiveSheet.Cells(i, 10) & "'" & ","  
        Else  
        sql = sql & "NULL,"  
        End If  
                If ActiveSheet.Cells(i, 11) <> Empty Then  
        sql = sql & "'" & ActiveSheet.Cells(i, 11) & "'" & ","  
        Else  
        sql = sql & "NULL,"  
        End If  
         
        If ActiveSheet.Cells(i, 12) <> Empty Then  
        sql = sql & "'" & ActiveSheet.Cells(i, 12) & "'" & ","  
        Else  
        sql = sql & "NULL,"  
        End If  
         
        If ActiveSheet.Cells(i, 13) <> Empty Then  
        sql = sql & "'" & ActiveSheet.Cells(i, 13) & "'" & ","  
        Else  
        sql = sql & "NULL,"  
        End If  
         
        If ActiveSheet.Cells(i, 14) <> Empty Then  
        sql = sql & "'" & ActiveSheet.Cells(i, 14) & "'" & ","  
        Else  
        sql = sql & "NULL,"  
        End If  
         
        If ActiveSheet.Cells(i, 15) <> Empty Then  
        sql = sql & "'" & ActiveSheet.Cells(i, 15) & "'" & ","  
        Else  
        sql = sql & "NULL,"  
        End If  
         
        If ActiveSheet.Cells(i, 16) <> Empty Then  
        sql = sql & "'" & ActiveSheet.Cells(i, 16) & "'" & ","  
        Else  
        sql = sql & "NULL,"  
        End If  
         
        If ActiveSheet.Cells(i, 17) <> Empty Then  
        sql = sql & "'" & ActiveSheet.Cells(i, 17) & "'" & ","  
        Else  
        sql = sql & "NULL,"  
        End If  
         
         
        If ActiveSheet.Cells(i, 18) <> Empty Then  
        sql = sql & "'" & ActiveSheet.Cells(i, 18) & "'" & ","  
        Else  
        sql = sql & "NULL,"  
        End If  
         
        sql = sql & "'sys',"  
        sql = sql & "'" & sysdate & "'" & ","  
        sql = sql & "'sys',"  
        sql = sql & "'" & sysdate & "'"  
        sql = sql & ")"  
         
        Print \#intFileNo, sql  
         
      End If  
       
        If ActiveSheet.Cells(i, 2) = Empty Then  
           Exit Do  
        End If

i = i + 1  
      Loop  
       
          '--------M採番情報構成----------------  
    ElseIf strTableName = "m\_auto\_no\_rule" Then  
     
        '--------- delete recorder ------------------------------------------------------------------\*  
    sql = ""  
    sql = " DELETE FROM " & strTableName  
    Print \#intFileNo, sql  
    sql = "GO"  
    Print \#intFileNo, sql  
     
    sql = ""  
    i = KOUMOKU\_ROW  
    '--------- read recorder ------------------------------------------------------------------\*  
     
    Do  
       
      mmcd\_kbn = Worksheets(3).Cells(i, NO\_COL)  
             
      If mmcd\_kbn <> Empty Then  
       
        sql = " INSERT INTO " & strTableName  
        sql = sql & " ("  
        sql = sql & "auto\_kbn,"  
        sql = sql & "head1,"  
        sql = sql & "head2,"  
        sql = sql & "no\_widths,"  
        sql = sql & "start\_no,"  
        sql = sql & "end\_no,"  
        sql = sql & "remark,"  
        sql = sql & "ins\_emp\_cd,"  
        sql = sql & "ins\_date,"  
        sql = sql & "upd\_emp\_cd,"  
        sql = sql & "upd\_date"  
        sql = sql & ")"  
        sql = sql & "VALUES"  
        sql = sql & " ("  
        sql = sql & "'" & ActiveSheet.Cells(i, 2) & "'" & ","  
         
        If ActiveSheet.Cells(i, 5) <> Empty Then  
        sql = sql & "'" & Left(ActiveSheet.Cells(i, 5), 2) & "'" & ","  
        Else  
        sql = sql & "NULL,"  
        End If  
         
        sql = sql & "NULL,"

If ActiveSheet.Cells(i, 4) <> Empty Then  
        sql = sql & "'" & ActiveSheet.Cells(i, 4) & "'" & ","  
        Else  
        sql = sql & "NULL,"  
        End If  
         
        If ActiveSheet.Cells(i, 6) <> Empty Then  
        sql = sql & "'" & ActiveSheet.Cells(i, 6) & "'" & ","  
        Else  
        sql = sql & "NULL,"  
        End If  
         
        If ActiveSheet.Cells(i, 7) <> Empty Then  
        sql = sql & "'" & ActiveSheet.Cells(i, 7) & "'" & ","  
        Else  
        sql = sql & "NULL,"  
        End If  
         
        If ActiveSheet.Cells(i, 9) <> Empty Then  
        sql = sql & "'" & ActiveSheet.Cells(i, 9) & "'" & ","  
        Else  
        sql = sql & "NULL,"  
        End If  
         
        sql = sql & "'sys',"  
        sql = sql & "'" & sysdate & "'" & ","  
        sql = sql & "'sys',"  
        sql = sql & "'" & sysdate & "'"  
        sql = sql & ")"  
         
        Print \#intFileNo, sql  
         
      End If  
       
        If ActiveSheet.Cells(i, 2) = Empty Then  
           Exit Do  
        End If

i = i + 1  
      Loop  
    End If  
     
    sql = "GO"  
    Print \#intFileNo, sql  
    Print \#intFileNo,  
     
    Close \#intFileNo  
    If no <> 1 Then  
       MsgBox ("INSERT\_TBLSQL作成終了" & vbCrLf & sqlfname)  
    End If  
End Sub

''' -----------------------------------------------------------------------------  
''' Project  : DUPLO  
'''  
''' -----------------------------------------------------------------------------  
''' <summary>  
''' </summary>  
''' <remarks>All\_Insert\_SQL文処理(すべて生成)  
''' </remarks>  
''' <history>  
'''     2010/03/12  Created  
''' </history>  
''' -----------------------------------------------------------------------------  
Sub Sql\_Create\_All()

Dim sql         As String  
    Dim intFileNo       As Integer  
    Dim sqlfname       As String  
         
    If sqlfname = "False" Then    ' <cancel> ボタンを選択した場合.  
        Exit Sub  
    End If  
    If all = 1 Then  
        sqlfname = Application.ActiveWorkbook.Path & "/all\_crate\_master.sql"  
    Else  
        sqlfname = Application.ActiveWorkbook.Path & "/" & "all\_insert" & ".sql"  
    End If  
   
    If sqlfname = "False" Then     ' <cancel> ボタンを選択した場合.  
        Exit Sub  
    End If

'--------Mメッセージ----------------  
       
        '--------- delete recorder ------------------------------------------------------------------\*  
        sql = ""  
        sql = " DELETE FROM " & "m\_message"  
        Print \#intFileNo, sql  
        sql = "GO"  
        Print \#intFileNo, sql  
         
        sql = ""  
        i = KOUMOKU\_ROW  
        '--------- read recorder ------------------------------------------------------------------\*  
         
          Do  
           
          mmcd\_kbn = Worksheets(2).Cells(i, NO\_COL)  
                 
          If mmcd\_kbn <> Empty Then  
           
            sql = " INSERT INTO " & "m\_message"  
            sql = sql & " ("  
            sql = sql & "message\_id,"  
            sql = sql & "message\_type,"  
            sql = sql & "message\_contents,"  
            sql = sql & "hint,"  
            sql = sql & "remark,"  
            sql = sql & "ins\_emp\_cd,"  
            sql = sql & "ins\_date,"  
            sql = sql & "upd\_emp\_cd,"  
            sql = sql & "upd\_date"  
            sql = sql & ")"  
            sql = sql & "VALUES"  
            sql = sql & " ("  
            sql = sql & "'" & Worksheets(2).Cells(i, 2) & "'" & ","  
             
            If Worksheets(2).Cells(i, 3) <> Empty Then  
            sql = sql & "'" & Worksheets(2).Cells(i, 3) & "'" & ","  
            Else  
            sql = sql & "'',"  
            End If  
             
            If Worksheets(2).Cells(i, 4) <> Empty Then  
            sql = sql & "'" & Worksheets(2).Cells(i, 4) & "'" & ","  
            Else  
            sql = sql & "'',"  
            End If  
             
            If Worksheets(2).Cells(i, 5) <> Empty Then  
            sql = sql & "'" & Worksheets(2).Cells(i, 5) & "'" & ","  
            Else  
            sql = sql & "NULL,"  
            End If  
             
            If Worksheets(2).Cells(i, 6) <> Empty Then  
            sql = sql & "'" & Worksheets(2).Cells(i, 6) & "'" & ","  
            Else  
            sql = sql & "NULL,"  
            End If  
             
            sql = sql & "'sys',"  
            sql = sql & "'" & sysdate & "'" & ","  
            sql = sql & "'sys',"  
            sql = sql & "'" & sysdate & "'"  
            sql = sql & ")"  
             
            Print \#intFileNo, sql  
             
          End If  
           
        If Worksheets(2).Cells(i, 2) = Empty Then  
           Exit Do  
        End If

i = i + 1  
      Loop  
           
          '--------M採番情報構成----------------  
        '--------- delete recorder ------------------------------------------------------------------\*  
    sql = ""  
    sql = " DELETE FROM " & "m\_auto\_no\_rule"  
    Print \#intFileNo, sql; ""  
    sql = "GO"  
    Print \#intFileNo, sql  
     
    sql = ""  
    i = KOUMOKU\_ROW  
    '--------- read recorder ------------------------------------------------------------------\*  
     
      Do  
       
      mmcd\_kbn = Worksheets(3).Cells(i, NO\_COL)  
             
      If mmcd\_kbn <> Empty Then  
       
        sql = " INSERT INTO " & "m\_auto\_no\_rule"  
        sql = sql & " ("  
        sql = sql & "auto\_kbn,"  
        sql = sql & "head1,"  
        sql = sql & "head2,"  
        sql = sql & "no\_widths,"  
        sql = sql & "start\_no,"  
        sql = sql & "end\_no,"  
        sql = sql & "remark,"  
        sql = sql & "ins\_emp\_cd,"  
        sql = sql & "ins\_date,"  
        sql = sql & "upd\_emp\_cd,"  
        sql = sql & "upd\_date"  
        sql = sql & ")"  
        sql = sql & "VALUES"  
        sql = sql & " ("  
        sql = sql & "'" & Worksheets(3).Cells(i, 2) & "'" & ","  
         
        If Worksheets(3).Cells(i, 5) <> Empty Then  
        sql = sql & "'" & Left(Worksheets(3).Cells(i, 5), 2) & "'" & ","  
        Else  
        sql = sql & "NULL,"  
        End If  
         
        sql = sql & "NULL,"

If Worksheets(3).Cells(i, 4) <> Empty Then  
        sql = sql & "'" & Worksheets(3).Cells(i, 4) & "'" & ","  
        Else  
        sql = sql & "NULL,"  
        End If  
         
        If Worksheets(3).Cells(i, 6) <> Empty Then  
        sql = sql & "'" & Worksheets(3).Cells(i, 6) & "'" & ","  
        Else  
        sql = sql & "NULL,"  
        End If  
         
        If Worksheets(3).Cells(i, 7) <> Empty Then  
        sql = sql & "'" & Worksheets(3).Cells(i, 7) & "'" & ","  
        Else  
        sql = sql & "NULL,"  
        End If  
         
        If Worksheets(3).Cells(i, 9) <> Empty Then  
        sql = sql & "'" & Worksheets(3).Cells(i, 9) & "'" & ","  
        Else  
        sql = sql & "NULL,"  
        End If  
         
        sql = sql & "'sys',"  
        sql = sql & "'" & sysdate & "'" & ","  
        sql = sql & "'sys',"  
        sql = sql & "'" & sysdate & "'"  
        sql = sql & ")"  
         
        Print \#intFileNo, sql  
         
      End If  
       
        If Worksheets(3).Cells(i, 2) = Empty Then  
           Exit Do  
        End If

i = i + 1  
      Loop

'--------M管理----------------  
     
        '--------- delete recorder ------------------------------------------------------------------\*  
    sql = ""  
    sql = " DELETE FROM " & "m\_manage"  
    Print \#intFileNo, sql  
    sql = "GO"  
    Print \#intFileNo, sql  
     
    sql = ""  
    i = KOUMOKU\_ROW  
    '--------- read recorder ------------------------------------------------------------------\*  
     
      Do  
       
      mmcd\_kbn = Worksheets(4).Cells(i, NO\_COL)  
             
      If mmcd\_kbn <> Empty Then  
       
        sql = " INSERT INTO " & "m\_manage"  
        sql = sql & " ("  
        sql = sql & "manage\_flg,"  
        sql = sql & "key1,"  
        sql = sql & "key2,"  
        sql = sql & "key3,"  
        sql = sql & "key4,"  
        sql = sql & "key5,"  
        sql = sql & "char1,"  
        sql = sql & "char2,"  
        sql = sql & "char3,"  
        sql = sql & "char4,"  
        sql = sql & "char5,"  
        sql = sql & "char6,"  
        sql = sql & "char7,"  
        sql = sql & "char8,"  
        sql = sql & "char9,"  
        sql = sql & "char10,"  
        sql = sql & "remark,"  
        sql = sql & "ins\_emp\_cd,"  
        sql = sql & "ins\_date,"  
        sql = sql & "upd\_emp\_cd,"  
        sql = sql & "upd\_date"  
        sql = sql & ")"  
        sql = sql & "VALUES"  
        sql = sql & " ("  
        sql = sql & "'" & Worksheets(4).Cells(i, 2) & "'" & ","  
        sql = sql & "'" & Worksheets(4).Cells(i, 3) & "'" & ","  
        sql = sql & "'" & Worksheets(4).Cells(i, 4) & "'" & ","  
        sql = sql & "'" & Worksheets(4).Cells(i, 5) & "'" & ","  
        sql = sql & "'" & Worksheets(4).Cells(i, 6) & "'" & ","  
        sql = sql & "'" & Worksheets(4).Cells(i, 7) & "'" & ","  
         
        If Worksheets(4).Cells(i, 8) <> Empty Then  
        sql = sql & "'" & Worksheets(4).Cells(i, 8) & "'" & ","  
        Else  
        sql = sql & "NULL,"  
        End If  
         
        If Worksheets(4).Cells(i, 9) <> Empty Then  
        sql = sql & "'" & Worksheets(4).Cells(i, 9) & "'" & ","  
        Else  
        sql = sql & "NULL,"  
        End If  
         
        If Worksheets(4).Cells(i, 10) <> Empty Then  
        sql = sql & "'" & Worksheets(4).Cells(i, 10) & "'" & ","  
        Else  
        sql = sql & "NULL,"  
        End If  
                If Worksheets(4).Cells(i, 11) <> Empty Then  
        sql = sql & "'" & Worksheets(4).Cells(i, 11) & "'" & ","  
        Else  
        sql = sql & "NULL,"  
        End If  
         
        If Worksheets(4).Cells(i, 12) <> Empty Then  
        sql = sql & "'" & Worksheets(4).Cells(i, 12) & "'" & ","  
        Else  
        sql = sql & "NULL,"  
        End If  
         
        If Worksheets(4).Cells(i, 13) <> Empty Then  
        sql = sql & "'" & Worksheets(4).Cells(i, 13) & "'" & ","  
        Else  
        sql = sql & "NULL,"  
        End If  
         
        If Worksheets(4).Cells(i, 14) <> Empty Then  
        sql = sql & "'" & Worksheets(4).Cells(i, 14) & "'" & ","  
        Else  
        sql = sql & "NULL,"  
        End If  
         
        If Worksheets(4).Cells(i, 15) <> Empty Then  
        sql = sql & "'" & Worksheets(4).Cells(i, 15) & "'" & ","  
        Else  
        sql = sql & "NULL,"  
        End If  
         
        If Worksheets(4).Cells(i, 16) <> Empty Then  
        sql = sql & "'" & Worksheets(4).Cells(i, 16) & "'" & ","  
        Else  
        sql = sql & "NULL,"  
        End If  
         
        If Worksheets(4).Cells(i, 17) <> Empty Then  
        sql = sql & "'" & Worksheets(4).Cells(i, 17) & "'" & ","  
        Else  
        sql = sql & "NULL,"  
        End If  
         
         
        If Worksheets(4).Cells(i, 18) <> Empty Then  
        sql = sql & "'" & Worksheets(4).Cells(i, 18) & "'" & ","  
        Else  
        sql = sql & "NULL,"  
        End If  
         
        sql = sql & "'sys',"  
        sql = sql & "'" & sysdate & "'" & ","  
        sql = sql & "'sys',"  
        sql = sql & "'" & sysdate & "'"  
        sql = sql & ")"  
         
        Print \#intFileNo, sql  
         
      End If  
       
        If Worksheets(4).Cells(i, 2) = Empty Then  
           Exit Do  
        End If

i = i + 1  
      Loop

sql = "GO"  
    Print \#intFileNo, sql  
    Print \#intFileNo,  
     
    Close \#intFileNo  
End Sub