Excel生成建表角本

Posted 2020-09-18 blf

 

 

使用宏生成建表角本：

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 & "\\DB\\DBS")
       FSO.CreateFolder (ThisWorkbook.Path & "\\DB\\DBS\\" & mysheet1.Range("A2").Value & "")
       FSO.CreateFolder (ThisWorkbook.Path & "\\DB\\DBS\\" & mysheet1.Range("A2").Value & "\\Tables")
       FSO.CreateFolder (ThisWorkbook.Path & "\\DB\\PATCH")
       
       Set Fcreate_run = FSO.CreateTextFile(ThisWorkbook.Path & "\\DB\\PATCH\\run.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 & "\\DB\\DBS\\" & mysheet1.Range("A2").Value & "\\Tables\\" & mysheet.Range("A" & i).Value & ".tab") Then \'判断SQL文件是否存在
              Set Fopen = FSO.OpenTextFile(ThisWorkbook.Path & "\\DB\\DBS\\" & 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 & "\\DB\\DBS\\" & 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 & "\\DB\\PATCH\\run.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 & "\\DB\\DBS\\" & mysheet1.Range("A2").Value & "\\Tables\\" & mysheet.Range("A" & i).Value & ".tab") Then \'判断SQL文件是否存在
              Set Fopen = FSO.OpenTextFile(ThisWorkbook.Path & "\\DB\\DBS\\" & 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