Excel生成建表角本

使用宏生成建表角本：

Private Sub CreateFile()
    Dim Fcreate As Object '建表头
    Dim FSO As Object
    Dim Fopen As Object '追加语句
    Dim Dir As Object '建目录
    Dim Fcreate_run As Object '总调角本
    
    Set mysheet1 = Workbooks(ThisWorkbook.Name).Sheets(1) 'Sheets1
    Set mysheet = Workbooks(ThisWorkbook.Name).Sheets(2) 'Sheets2
    
    Set FSO = CreateObject("Scripting.FileSystemObject")
    
    '建目录
    If FSO.FolderExists(ThisWorkbook.Path & "DB") = False Then '判断文件夹是否存在
       FSO.CreateFolder (ThisWorkbook.Path & "DB")
       FSO.CreateFolder (ThisWorkbook.Path & "DBDBS")
       FSO.CreateFolder (ThisWorkbook.Path & "DBDBS" & mysheet1.Range("A2").Value & "")
       FSO.CreateFolder (ThisWorkbook.Path & "DBDBS" & mysheet1.Range("A2").Value & "Tables")
       FSO.CreateFolder (ThisWorkbook.Path & "DBPATCH")
       
       Set Fcreate_run = FSO.CreateTextFile(ThisWorkbook.Path & "DBPATCH
un.sql", True) '建总调角本
       Fcreate_run.WriteLine ("-- Create Tables ")
       Fcreate_run.Close
       Set Fcreate_run = Nothing
       
    End If
    
    
    
    
    '建表块
    For i = 2 To mysheet.UsedRange.Rows.Count '遍历所有的列
        If mysheet.Range("H" & i).Value = mysheet1.Range("B2").Value Then '判断版本是否一致
           If FSO.FileExists(ThisWorkbook.Path & "DBDBS" & mysheet1.Range("A2").Value & "Tables" & mysheet.Range("A" & i).Value & ".tab") Then '判断SQL文件是否存在
              Set Fopen = FSO.OpenTextFile(ThisWorkbook.Path & "DBDBS" & mysheet1.Range("A2").Value & "Tables" & mysheet.Range("A" & i).Value & ".tab", 8, False)
           
              Fopen.Write ("   ," & mysheet.Range("C" & i).Value & "   " & mysheet.Range("E" & i).Value)
              If mysheet.Range("G" & i).Value = "Y" Then '非空处理
                 Fopen.WriteLine (" not null")
              Else
                 Fopen.WriteLine ("")
              End If
           
              If mysheet.Range("A" & i).Value <> mysheet.Range("A" & i + 1).Value Then '字段结束判断
                 Fopen.WriteLine (")")
                 Fopen.WriteLine ("tablespace ODSDATA';")
                 Fopen.WriteLine ("END;")
                 Fopen.WriteLine ("/")
              End If
           
              Fopen.Close
              Set Fopen = Nothing
           Else
              '建表头
              Set Fcreate = FSO.CreateTextFile(ThisWorkbook.Path & "DBDBS" & mysheet1.Range("A2").Value & "Tables" & mysheet.Range("A" & i).Value & ".tab", True)
              Fcreate.WriteLine ("DECLARE ")
              Fcreate.WriteLine ("v_tab_count NUMBER;")
              Fcreate.WriteLine ("BEGIN")
              Fcreate.WriteLine ("  SELECT COUNT(*) INTO v_tab_count")
              Fcreate.WriteLine ("    FROM ALL_TABLES t ")
              Fcreate.WriteLine ("   WHERE t.OWNER='" & mysheet1.Range("A2").Value & "'")
              Fcreate.WriteLine ("     AND t.TABLE_NAME='" & mysheet.Range("A" & i).Value & "'")
              Fcreate.WriteLine ("  ;")
              Fcreate.WriteLine ("  IF v_tab_count>0 THEN")
              Fcreate.WriteLine ("    EXECUTE IMMEDIATE 'drop table " & mysheet1.Range("A2").Value & "." & mysheet.Range("A" & i).Value & "';")
              Fcreate.WriteLine ("  END IF;")
              Fcreate.WriteLine ("")
              Fcreate.WriteLine ("  EXECUTE IMMEDIATE 'CREATE TABLE " & mysheet1.Range("A2").Value & "." & mysheet.Range("A" & i).Value & "")
              Fcreate.Write ("(  " & mysheet.Range("C" & i).Value & "   " & mysheet.Range("E" & i).Value)
              If mysheet.Range("G" & i).Value = "Y" Then  '非空处理
                 Fcreate.WriteLine (" not null")
              End If
              Fcreate.Close
              Set Fcreate = Nothing
              
              '建总调角本
              Set Fcreate_run = FSO.OpenTextFile(ThisWorkbook.Path & "DBPATCH
un.sql", 8, False)
              Fcreate_run.WriteLine ("@../DBS/" & mysheet1.Range("A2").Value & "/Tables/" & mysheet.Range("A" & i).Value & ".tab")
              Fcreate_run.Close
              Set Fcreate_run = Nothing
              
              
           End If
       End If
    Next i
    
       '备注
    For i = 2 To mysheet.UsedRange.Rows.Count '遍历所有的列
        If mysheet.Range("H" & i).Value = mysheet1.Range("B2").Value Then '判断版本是否一致
           If FSO.FileExists(ThisWorkbook.Path & "DBDBS" & mysheet1.Range("A2").Value & "Tables" & mysheet.Range("A" & i).Value & ".tab") Then '判断SQL文件是否存在
              Set Fopen = FSO.OpenTextFile(ThisWorkbook.Path & "DBDBS" & mysheet1.Range("A2").Value & "Tables" & mysheet.Range("A" & i).Value & ".tab", 8, False)
              
              If mysheet.Range("A" & i).Value <> mysheet.Range("A" & i - 1).Value Then
                 Fopen.WriteLine ("-- Add comments to the table ")
                 Fopen.WriteLine ("comment on table " & mysheet1.Range("A2").Value & "." & mysheet.Range("A" & i).Value & "")
                 Fopen.WriteLine ("  is '" & mysheet.Range("B" & i).Value & "';")
              
                 Fopen.WriteLine ("-- Add comments to the columns ")
                 Fopen.WriteLine ("comment on column " & mysheet1.Range("A2").Value & "." & mysheet.Range("A" & i).Value & "." & mysheet.Range("C" & i).Value & "")
                 Fopen.WriteLine ("  is '" & mysheet.Range("D" & i).Value & "';")
              Else
                 Fopen.WriteLine ("comment on column " & mysheet1.Range("A2").Value & "." & mysheet.Range("A" & i).Value & "." & mysheet.Range("C" & i).Value & "")
                 Fopen.WriteLine ("  is '" & mysheet.Range("D" & i).Value & "';")
              End If
           
              Fopen.Close
              Set Fopen = Nothing
           End If
       End If
    Next i
    
    
    Set FSO = Nothing
    
    
End Sub