脚本第二集

这次是SQL脚本

'******************************************************************************
'* File:     CreateViews.vbs
'* Purpose:  This VB Script creates a view for each table.
'* Title:    Create a view for each table
'* Category: Create Procedure
'* Version:  1.0
'* Company:  Sybase Inc. 
'******************************************************************************

Option Explicit

'-----------------------------------------------------------------------------
' Main function
'-----------------------------------------------------------------------------

ValidationMode = True

Dim mdl ' the current model

' get the current active model
Set mdl = ActiveModel
If (mdl Is Nothing) Then
   MsgBox "There is no current Model."
ElseIf Not mdl.IsKindOf(PdPDM.cls_Model) Then
   MsgBox "The current model is not a Physical Data model."
Else
   ProcessFolder mdl
End If


'--------------------------------------------------------------------------------
' This routine creates a tablespace for each table
' of the current folder
'--------------------------------------------------------------------------------
Private Sub ProcessFolder(folder)
   Dim Tab  'table
   Dim Proc 'new Proc
   Dim Col  'Cols of the table
   Dim ProcCol ' Col of the Proc
   Dim SqlStmt

   ' Get the class diagram
   Dim diagram
   Dim sym
   Set diagram = folder.PhysicalDiagrams.Item(0)

   For each Tab in folder.Tables
      If not Tab.isShortcut then
         ' Test if there is a view with the same name or code
         Dim name, code, no
         name = "查找" + Tab.Name
         If  Mid(Tab.Code, 1, 3) = "tb_" or  Mid(Tab.Code, 1, 3) = "Tb_" or Mid(Tab.Code, 1, 3) = "TB_"  or Mid(Tab.Code, 1, 3) = "tB_" Then
               code= "Proc_Find_"+Mid(Tab.Code, 4, Len(Tab.Code) - 3)
          else
               code="Proc_Find_"+Tab.Code
          End If
          
         no = 1
         Do
            If Not hasProc(folder, name, code) Then
               Exit Do
            End If
            ' Try a new name & code
            no = no + 1
            name = "查找" + Tab.Name + CStr(no)
         If  Mid(Tab.Code, 1, 3) = "tb_" or  Mid(Tab.Code, 1, 3) = "Tb_" or Mid(Tab.Code, 1, 3) = "TB_"  or Mid(Tab.Code, 1, 3) = "tB_" Then
               code= "Proc_Find_"+Mid(Tab.Code, 4, Len(Tab.Code) - 3)+CStr(no)
          else
               code="Proc_Find_"+Tab.Code+CStr(no)
          End If
         Loop
         
         ' Create a new View
         Output "Create Proc: " + code
         
         set Proc = folder.CreateObject(PdPDM.cls_Procedure)
         Proc.Name = name
         Proc.Code = code
         
         CreateText Proc,Tab

         ' Create a symbol for the view
         Set sym = diagram.AttachObject(Proc)

      End If
   Next
End Sub

'--------------------------------------------------------------------------------
' This routine tests if there is a view with the same name or code
'--------------------------------------------------------------------------------
Private Function hasProc(folder, name, code)
   Dim Proc
   For each Proc in folder.Procedures
      If Not Proc.isShortcut Then
         If Proc.Name = name or Proc.Code = code Then
            hasProc = true
            Exit Function
         End If
      End If
   Next   
   hasProc = false
End Function

'----------------------------------------------------------------------------
'转换字母到大写
'----------------------------------------------------------------------------
Private Function upper(str ) 
Dim upperstr 
Dim i 
For i = 1 To Len(str)
   If Mid(str, i, 1) >= "a" And Mid(str, i, 1) <= "z" Then
        upperstr = upperstr + Chr(Asc(Mid(str, i, 1)) - 32)
   Else
      upperstr = upperstr + Mid(str, i, 1)
   End If
   
Next 
upper = upperstr
End Function


'----------------------------------------------------------------------------------
'生成存储过程
'----------------------------------------------------------------------------------
Private Function CreateText(Proc,Tab)
dim str,t
'创建存储过程
str="Create Procedure  "+Proc.code+vbCrLf
'填充存储过程的参数
dim i
dim pkname
dim pkcode
dim pktype
i=0
For each t in  Tab.columns
     if i=0 then
            pkname=t.name
            pkcode=t.code
            pktype=t.datatype
         str=str+"@"+t.code+vbTab+t.datatype+vbtab+","+vbCrLf
      end if
      i=i+1
Next 

i=0
For each t in  Tab.columns
     if i>0 then
         str=str+vbcrlf+"@"+t.code+vbTab+t.datatype+" output,"
      end if
    i=i+1  
Next 
str=left(str,len(str)-1)
str=str+vbcrlf
i=0



DIM stryg,x
x=FALSE
FOR EACH T IN TAB.COLUMNS
    IF UPPER(T.CODE)="C_YG_BH" THEN
         X=TRUE
         EXIT FOR
    END IF
NEXT




'填充员工编号
str=str+vbCrLf


str=str+"as"+vbCrLf


'填充事件的代码


str=str+"if  not exists(select  * from "+vbtab+tab.code+vbtab+"where"+vbtab+pkcode+"="+"@"+pkcode+")"+vbcrlf
str=str+"begin"+vbcrlf

str=str+vbtab+"return(6)"+vbcrlf
str=str+"end"+vbcrlf





str=str+"select"+vbtab
i=0
For each t in  Tab.columns
     if i>0 then
         str=str+"@"+t.code+"="+t.code+","
      end if
      i=i+1
Next 
str=left(str,len(str)-1)
str=str++vbtab+" from "+vbtab+tab.code+vbtab+"where  "+pkcode+"="+"@"+pkcode+vbcrlf
str=str+"return(0)"+vbcrlf






Proc.text=str
End Function

'******************************************************************************
'* File:     减少.vbs
'* Purpose:  This VB Script creates a view for each table.
'* Category: Create Procedure
'* Version:  1.0   基本
'******************************************************************************

Option Explicit

'-----------------------------------------------------------------------------
' Main function
'-----------------------------------------------------------------------------

ValidationMode = True

Dim mdl ' the current model

' get the current active model
Set mdl = ActiveModel
If (mdl Is Nothing) Then
   MsgBox "There is no current Model."
ElseIf Not mdl.IsKindOf(PdPDM.cls_Model) Then
   MsgBox "The current model is not a Physical Data model."
Else
   ProcessFolder mdl
End If


'--------------------------------------------------------------------------------
' This routine creates a tablespace for each table
' of the current folder
'--------------------------------------------------------------------------------
Private Sub ProcessFolder(folder)
   Dim Tab  'table
   Dim Proc 'new Proc
   Dim Col  'Cols of the table
   Dim ProcCol ' Col of the Proc
   Dim SqlStmt

   ' Get the class diagram
   Dim diagram
   Dim sym
   Set diagram = folder.PhysicalDiagrams.Item(0)

   For each Tab in folder.Tables
      If not Tab.isShortcut then
         ' Test if there is a view with the same name or code
         Dim name, code, no
         name = "减少" + Tab.Name
         If  Mid(Tab.Code, 1, 3) = "tb_" or  Mid(Tab.Code, 1, 3) = "Tb_" or Mid(Tab.Code, 1, 3) = "TB_"  or Mid(Tab.Code, 1, 3) = "tB_" Then
               code= "Proc_Del_"+Mid(Tab.Code, 4, Len(Tab.Code) - 3)
          else
               code="Proc_Del_"+Tab.Code
          End If
          
         no = 1
         Do
            If Not hasProc(folder, name, code) Then
               Exit Do
            End If
            ' Try a new name & code
            no = no + 1
            name = "减少" + Tab.Name + CStr(no)
         If  Mid(Tab.Code, 1, 3) = "tb_" or  Mid(Tab.Code, 1, 3) = "Tb_" or Mid(Tab.Code, 1, 3) = "TB_"  or Mid(Tab.Code, 1, 3) = "tB_" Then
               code= "Proc_Del_"+Mid(Tab.Code, 4, Len(Tab.Code) - 3)+CStr(no)
          else
               code="Proc_Del_"+Tab.Code+CStr(no)
          End If
         Loop
         
         ' Create a new View
         Output "Create Proc: " + code
         
         set Proc = folder.CreateObject(PdPDM.cls_Procedure)
         Proc.Name = name
         Proc.Code = code
         
         CreateText Proc,Tab

         ' Create a symbol for the view
         Set sym = diagram.AttachObject(Proc)

      End If
   Next
End Sub

'--------------------------------------------------------------------------------
' This routine tests if there is a view with the same name or code
'--------------------------------------------------------------------------------
Private Function hasProc(folder, name, code)
   Dim Proc
   For each Proc in folder.Procedures
      If Not Proc.isShortcut Then
         If Proc.Name = name or Proc.Code = code Then
            hasProc = true
            Exit Function
         End If
      End If
   Next   
   hasProc = false
End Function
'----------------------------------------------------------------------------------
'生成存储过程
'----------------------------------------------------------------------------------
Private Function CreateText(Proc,Tab)
dim str,t
'创建存储过程
str="Create Procedure  "+Proc.code+vbCrLf
'填充存储过程的参数
dim index'主键code
dim i
dim x
i=0
x=0
'x=1为列表参数有员工
For each t in  Tab.columns
     if t.code="c_YG_Bh" then x=1
     if i=0 then
         index=t.code
         str=str+"@"+ index+vbTab+t.datatype+vbCrLf
     end if
    i=i+1  
Next 

'填充员工编号




str=str+"as"+vbCrLf

'填充事件的代码

 
str=str+"delete   " +tab.code+"    where  "
str=str+index+"=@"+index+vbcrlf

str=str+"IF @@ERROR<>0 OR @@ROWCOUNT=0"+vbcrlf
str=str+"BEGIN"+vbcrlf
str=str+"RETURN(8)"+vbcrlf
str=str+"end"+vbcrlf



Proc.text=str
End Function

dim mdl
Set mdl = ActiveModel
for each proc in mdl.procedures
     proc.delete()
next

dim mdl
Set mdl = ActiveModel
for each vw in mdl.views
     vw.delete()
next

'******************************************************************************
'* File:     修改.vbs
'* Purpose:  This VB Script creates a view for each table.
'* Category: Create Procedure
'* Version:  1.0  基本版本

'******************************************************************************

Option Explicit

'-----------------------------------------------------------------------------
' Main function
'-----------------------------------------------------------------------------

ValidationMode = True

Dim mdl ' the current model

' get the current active model
Set mdl = ActiveModel
If (mdl Is Nothing) Then
   MsgBox "There is no current Model."
ElseIf Not mdl.IsKindOf(PdPDM.cls_Model) Then
   MsgBox "The current model is not a Physical Data model."
Else
   ProcessFolder mdl
End If


'--------------------------------------------------------------------------------
' This routine creates a tablespace for each table
' of the current folder
'--------------------------------------------------------------------------------
Private Sub ProcessFolder(folder)
   Dim Tab  'table
   Dim Proc 'new Proc
   Dim Col  'Cols of the table
   Dim ProcCol ' Col of the Proc
   Dim SqlStmt

   ' Get the class diagram
   Dim diagram
   Dim sym
   Set diagram = folder.PhysicalDiagrams.Item(0)

   For each Tab in folder.Tables
      If not Tab.isShortcut then
         ' Test if there is a view with the same name or code
         Dim name, code, no
         name = "修改" + Tab.Name
         If  Mid(Tab.Code, 1, 3) = "tb_" or  Mid(Tab.Code, 1, 3) = "Tb_" or Mid(Tab.Code, 1, 3) = "TB_"  or Mid(Tab.Code, 1, 3) = "tB_" Then
               code= "Proc_Upd_"+Mid(Tab.Code, 4, Len(Tab.Code) - 3)
          else
               code="Proc_Upd_"+Tab.Code
          End If
          
         no = 1
         Do
            If Not hasProc(folder, name, code) Then
               Exit Do
            End If
            ' Try a new name & code
            no = no + 1
            name = "修改" + Tab.Name + CStr(no)
         If  Mid(Tab.Code, 1, 3) = "tb_" or  Mid(Tab.Code, 1, 3) = "Tb_" or Mid(Tab.Code, 1, 3) = "TB_"  or Mid(Tab.Code, 1, 3) = "tB_" Then
               code= "Proc_Upd_"+Mid(Tab.Code, 4, Len(Tab.Code) - 3)+CStr(no)
          else
               code="Proc_Upd_"+Tab.Code+CStr(no)
          End If
         Loop
         
         ' Create a new View
         Output "Create Proc: " + code
         
         set Proc = folder.CreateObject(PdPDM.cls_Procedure)
         Proc.Name = name
         Proc.Code = code
         
         CreateText Proc,Tab

         ' Create a symbol for the view
         Set sym = diagram.AttachObject(Proc)

      End If
   Next
End Sub

'--------------------------------------------------------------------------------
' This routine tests if there is a view with the same name or code
'--------------------------------------------------------------------------------
Private Function hasProc(folder, name, code)
   Dim Proc
   For each Proc in folder.Procedures
      If Not Proc.isShortcut Then
         If Proc.Name = name or Proc.Code = code Then
            hasProc = true
            Exit Function
         End If
      End If
   Next   
   hasProc = false
End Function
'----------------------------------------------------------------------------
'转换字母到大写
'----------------------------------------------------------------------------
Private Function upper(str ) 
Dim upperstr 
Dim i 
For i = 1 To Len(str)
   If Mid(str, i, 1) >= "a" And Mid(str, i, 1) <= "z" Then
        upperstr = upperstr + Chr(Asc(Mid(str, i, 1)) - 32)
   Else
      upperstr = upperstr + Mid(str, i, 1)
   End If
   
Next 
upper = upperstr
End Function
'----------------------------------------------------------------------------------
'生成存储过程
'----------------------------------------------------------------------------------
Private Function CreateText(Proc,Tab)
dim str,t,i
'创建存储过程
str=str+"--创建存储过程:"+Proc.name+vbCrLf+vbCrLf

str=str+"Create Procedure  "+Proc.code+vbCrLf
str=str+"--填充存储过程的参数"+vbCrLf
'填充存储过程的参数
dim stryg,b,X
B=FALSE
FOR EACH   X IN TAB.COLUMNS
    IF UPPER(X.CODE)="C_YG_BH" THEN
      B=TRUE
      EXIT FOR
    END IF
NEXT

   STRYG="@C_YG_BH0"


i=0
For Each t  in Tab.columns
     if i=0 then
      str=str+"@"+t.code+vbTab+t.datatype+","+vbCrLf
      '填充员工编号
      i=i+1
     else '如果里面有员工的编号则生成一个员工编号0的
        str=str+"@"+t.code+vbTab+t.datatype+"=NULL,"+vbCrLf    
      end if
Next 
'去,

str=left(str,len(str)-3)+vbcrlf

str=str+"AS"+vbCrLf
str=str+"update"+vbtab+TAB.CODE+vbtab+"set"+vbtab

'修改
dim pkey
i=0
For Each t  in Tab.columns
      if i=0 then
         i=i+1
         set pkey=t
      else
        str=str+t.code+"="+"@"+t.code+","
     end if
Next 
str=left(str,len(str)-1)
str=str+vbtab

str=str+"where"+vbtab+pkey.code+"="+"@"+pkey.code

str=str+vbcrlf


'i=0'
'For Each t  in Tab.columns
'      if i=0 then
'         i=i+1
'      else
 '        str=str+"DECLARE      @"+t.code+"1"+vbTab+t.datatype+vbCrLf
 '     end if
'Next 
'str=str+vbCrLf+vbCrLf'
'str=str+"---填充数据,传过来为NULL就不填充"+vbCrLf+vbCrLf

'str=str+"SELECT     "

'DIM PKEY '把主键先存起来,以后可以直接使用
'DIM PTYPE  '存放主键的类型


'I=0
'FOR EACH T IN TAB.COLUMNS  
     ' IF I=0 THEN
    '     I=I+1
   '      PKEY=T.CODE
  '       PTYPE=UPPER(T.DATATYPE)
 '      ELSE
  '        str=str+"@"+t.code+"1"+"=CASE WHEN  "+"@"+T.CODE+"    IS  NULL THEN NULL ELSE   "+T.CODE +"   END,"+vbCrLf
 '     END IF
'NEXT

'str=mid(str,1,len(str)-3)
'str=str+vbCrLf
'str=str+"     FROM "+TAB.CODE+"   WHERE    "+PKEY+"=@"+PKEY+vbCrLf+vbCrLf+vbCrlf

'str=str+"---构造更新字符串"+vbCrlf+vbCrLf

'str=str+"DECLARE @SQLSTR VARCHAR(200)"+vbCRLf

'str=str+"SET  @SQLSTR="
'I=0
'FOR EACH T IN TAB.COLUMNS
    '  IF I=0 THEN
   '    I=I+1
  '    ELSE
         '   str=str+"CASE  WHEN "+"@"+T.CODE+"    IS NOT NULL THEN   "+"'"+T.CODE+"='+"
        '    IF UPPER(MID(T.DATATYPE,1,7))="VARCHAR" OR UPPER(MID(T.DATATYPE,1,4))="CHAR" THEN
       '         str=str+"''''+CAST(@"+T.CODE+"  AS VARCHAR(100))+''''+',' ELSE ' 'END+"+vbCrLf
       '     ELSEIF UPPER(MID(T.DATATYPE,1,8))="DATETIME" OR UPPER(MID(T.DATATYPE,1,13))="SMALLDATETIME" THEN
     ''          str=str+"''''+CONVERT(VARCHAR(50),@"+T.CODE+",126)+''''+',' ELSE ' 'END+"+vbCrLf
    '        ELSE
   '            str=str+"CAST(@"+T.CODE+"  AS VARCHAR(100))+',' ELSE ' 'END+"+vbCrLf
  '          END IF
 '     END IF
'NEXT

'str=mid(str,1,len(str)-3)+vbCrlf

'str=str+"SET @SQLSTR=RTRIM(@SQLSTR)"+vbCrLf

'str=str+"IF RIGHT(@SQLSTR,1)=','"+vbCrLf
'str=str+"SET @SQLSTR=SUBSTRING(@SQLSTR,1,LEN(@SQLSTR)-1)"+vbCrLf
''
'str=str+"if rtrim(@sqlstr)<>''"+vbcrlf
'str=str+"begin"+vbcrlf

'str=str+"SET @SQLSTR='UPDATE  "+TAB.CODE+"   SET     '+@SQLSTR+'     WHERE     "+PKEY
'IF MID(PTYPE,1,7)="VARCHAR" OR MID(PTYPE,1,4)="CHAR" THEN
'   str=str+"='+''''+CAST(@"+PKEY+"  AS VARCHAR(100))+''''"+vbCrLf
'ELSE
 '  str=str+"='+CAST(@"+PKEY+"  AS VARCHAR(100))"+vbCrLf
 'END IF

'str=str+"EXEC(@SQLSTR)"+vbCrLf

str=str+"IF @@ERROR<>0 or @@rowcount=0"+vbCrLf
str=str+"BEGIN"+vbCrLf
str=str+"RETURN(8)"+vbCrLf
str=str+"END"+vbCrLf+vbCrLf+vbCrLf


Proc.text=str
End Function

'******************************************************************************
'* File:    增加
'* Purpose:  This VB Script creates a view for each table.
'* Category: Create Procedure
'* Version:  1.0 基本
'******************************************************************************

Option Explicit

'-----------------------------------------------------------------------------
' Main function
'-----------------------------------------------------------------------------

ValidationMode = True

Dim mdl ' the current model

' get the current active model
Set mdl = ActiveModel
If (mdl Is Nothing) Then
   MsgBox "There is no current Model."
ElseIf Not mdl.IsKindOf(PdPDM.cls_Model) Then
   MsgBox "The current model is not a Physical Data model."
Else
   ProcessFolder mdl
End If


'--------------------------------------------------------------------------------
' This routine creates a tablespace for each table
' of the current folder
'--------------------------------------------------------------------------------
Private Sub ProcessFolder(folder)
   Dim Tab  'table
   Dim Proc 'new Proc
   Dim Col  'Cols of the table
   Dim ProcCol ' Col of the Proc
   Dim SqlStmt

   ' Get the class diagram
   Dim diagram
   Dim sym
   Set diagram = folder.PhysicalDiagrams.Item(0)

   For each Tab in folder.Tables
      If not Tab.isShortcut then
         ' Test if there is a view with the same name or code
         Dim name, code, no
         name = "增加" + Tab.Name
         If  Mid(Tab.Code, 1, 3) = "tb_" or  Mid(Tab.Code, 1, 3) = "Tb_" or Mid(Tab.Code, 1, 3) = "TB_"  or Mid(Tab.Code, 1, 3) = "tB_" Then
               code= "Proc_Add_"+Mid(Tab.Code, 4, Len(Tab.Code) - 3)
          else
               code="Proc_Add_"+Tab.Code
          End If
          
         no = 1
         Do
            If Not hasProc(folder, name, code) Then
               Exit Do
            End If
            ' Try a new name & code
            no = no + 1
            name = "增加" + Tab.Name + CStr(no)
         If  Mid(Tab.Code, 1, 3) = "tb_" or  Mid(Tab.Code, 1, 3) = "Tb_" or Mid(Tab.Code, 1, 3) = "TB_"  or Mid(Tab.Code, 1, 3) = "tB_" Then
               code= "Proc_Add_"+Mid(Tab.Code, 4, Len(Tab.Code) - 3)+CStr(no)
          else
               code="Proc_Add_"+Tab.Code+CStr(no)
          End If
         Loop
         
         ' Create a new View
         Output "Create Proc: " + code
         
         set Proc = folder.CreateObject(PdPDM.cls_Procedure)
         Proc.Name = name
         Proc.Code = code
         
         CreateText Proc,Tab

         ' Create a symbol for the view
         Set sym = diagram.AttachObject(Proc)

      End If
   Next
End Sub

'--------------------------------------------------------------------------------
' This routine tests if there is a view with the same name or code
'--------------------------------------------------------------------------------
Private Function hasProc(folder, name, code)
   Dim Proc
   For each Proc in folder.Procedures
      If Not Proc.isShortcut Then
         If Proc.Name = name or Proc.Code = code Then
            hasProc = true
            Exit Function
         End If
      End If
   Next   
   hasProc = false
End Function

'----------------------------------------------------------------------------
'转换字母到大写
'----------------------------------------------------------------------------
Private Function upper(str ) 
Dim upperstr 
Dim i 
For i = 1 To Len(str)
   If Mid(str, i, 1) >= "a" And Mid(str, i, 1) <= "z" Then
        upperstr = upperstr + Chr(Asc(Mid(str, i, 1)) - 32)
   Else
      upperstr = upperstr + Mid(str, i, 1)
   End If
   
Next 
upper = upperstr
End Function


'----------------------------------------------------------------------------------
'生成存储过程
'----------------------------------------------------------------------------------
Private Function CreateText(Proc,Tab)
dim str,t
'创建存储过程
str="Create Procedure  "+Proc.code+vbCrLf
'填充存储过程的参数
dim i
i=0
For each t in  Tab.columns
     if i>0 then
         str=str+"@"+t.code+vbTab+t.datatype+"=NULL,"+vbCrLf
      end if
    i=i+1  
Next 
i=0

DIM stryg,x
x=FALSE
FOR EACH T IN TAB.COLUMNS
    IF UPPER(T.CODE)="C_YG_BH" THEN
         X=TRUE
         EXIT FOR
    END IF
NEXT

i=0
For each t in  Tab.columns
     if i=0 then
         str=str+"@"+t.code+vbTab+t.datatype+vbtab+"output"+vbCrLf
      end if
      i=i+1
Next 


'填充员工编号
str=str+vbCrLf


str=str+"as"+vbCrLf


'填充事件的代码

str=str+"insert   "+vbtab+tab.code+"("
i=0
For each t in  Tab.columns
     if i>0 then
         str=str+t.code+","
      end if
      i=i+1
Next 
str=left(str,len(str)-1)+")"+vbtab+"values("

i=0
For each t in  Tab.columns
     if i>0 then
         str=str+"@"+t.code+","
      end if
      i=i+1
Next 

str=left(str,len(str)-1)+")"+vbcrlf

str=str+"if @@error<>0  or @@rowcount=0"+vbcrlf
str=str+"begin"+vbcrlf

str=str+vbtab+"return(8)"+vbcrlf
str=str+"end"+vbcrlf

str=str+"set"+vbtab
i=0
For each t in  Tab.columns
     if i=0 then
         str=str+"@"+t.code
      end if
      i=i+1
Next 
str=str+"=@@IDENTITY"+vbcrlf


Proc.text=str
End Function

'******************************************************************************
'* File:     CreateViews.vbs
'* Purpose:  This VB Script creates a view for each table.
'* Title:    Create a view for each table
'* Category: Create Views
'* Version:  1.0
'* Company:  Sybase Inc. 
'******************************************************************************

Option Explicit

'-----------------------------------------------------------------------------
' Main function
'-----------------------------------------------------------------------------

ValidationMode = True

Dim mdl ' the current model

' get the current active model
Set mdl = ActiveModel
If (mdl Is Nothing) Then
   MsgBox "There is no current Model."
ElseIf Not mdl.IsKindOf(PdPDM.cls_Model) Then
   MsgBox "The current model is not a Physical Data model."
Else
   ProcessFolder mdl
End If


'--------------------------------------------------------------------------------
' This routine creates a tablespace for each table
' of the current folder
'--------------------------------------------------------------------------------
Private Sub ProcessFolder(folder)
   Dim Tab  'table
   Dim View 'new View
   Dim Col  'Cols of the table
   Dim ViewCol ' Col of the View
   Dim SqlStmt

   ' Get the class diagram
   Dim diagram
   Dim sym
   Set diagram = folder.PhysicalDiagrams.Item(0)

   For each Tab in folder.Tables
      If not Tab.isShortcut then
         ' Test if there is a view with the same name or code
         Dim name, code, no
         IF UPPER(MID(TAB.CODE,1,3))="TB_" THEN
                 name = "View" + Tab.Name
                  code = "VW_" +right(Tab.Code,len(tab.code)-3)
          ELSE
                 name = "View" + Tab.Name
                  code = "VW_" +Tab.Code
          END IF
         no = 1       
         Do
            If Not hasView(folder, name, code) Then
               Exit Do
            End If
            ' Try a new name & code
            no = no + 1
            IF UPPER(MID(TAB.CODE,1,3))="TB_" THEN
                        name = "View" + Tab.Name + CStr(no)
                        code = "VW" + MID(Tab.Code,4,LEN(TAB.CODE-3)) + CStr(no)
           ELSE
                        name = "View" + Tab.Name + CStr(no)
                        code = "VW" + Tab.Code + CStr(no)
            END IF           
         Loop
         
         ' Create a new View
         Output "Create View " + code
         
         set View = folder.Views.CreateNew
         View.Name = name
         View.Code = code

         ' Add Columns for the table to the View
         Dim noCol
         noCol = 0
         SqlStmt = "select  "
         For each Col in Tab.Columns
            If noCol > 0 Then
               SqlStmt = SqlStmt + ", "
            End If
            SqlStmt = SqlStmt + Col.Code+"   AS "+COL.NAME
            noCol = noCol + 1
         Next 
         'Set the referenz
         SqlStmt = SqlStmt + " from " + Tab.Code
         View.SQLQuery = SqlStmt

         ' Create a symbol for the view
         Set sym = diagram.AttachObject(View)

      End If
   Next
End Sub

'--------------------------------------------------------------------------------
' This routine tests if there is a view with the same name or code
'--------------------------------------------------------------------------------
Private Function hasView(folder, name, code)
   Dim View
   For each View in folder.Views
      If Not View.isShortcut Then
         If View.Name = name or View.Code = code Then
            hasView = true
            Exit Function
         End If
      End If
   Next   
   hasView = false
End Function
'----------------------------------------------------------------------------
'转换字母到大写
'----------------------------------------------------------------------------
Private Function upper(str ) 
Dim upperstr 
Dim i 
For i = 1 To Len(str)
   If Mid(str, i, 1) >= "a" And Mid(str, i, 1) <= "z" Then
        upperstr = upperstr + Chr(Asc(Mid(str, i, 1)) - 32)
   Else
      upperstr = upperstr + Mid(str, i, 1)
   End If
   
Next 
upper = upperstr
End Function

写完收工,这下就方便了