Skip to Content

Each time i wanted to created a database creation script, i had to:

  • search for inclusive indexes and delete them
  • search for indexes that don’t have columns in them, to delete them
  • add indexes for specific columns that are coming in a huge number of tables, like the dateG field.

so i created the following script to solve the above:

and also benefit in:

  • Learn how to Add an index
  • Learn how to remove an index
  • Learn how to search for Inclusive indexes
  • Learn how to search for an index
  • Learn how to search for columns in an index


Option Explicit
Dim mdl
Dim Fldr
Dim RQ
Dim isFound
Dim strLongReferenceNames
dim iCountChanged, iCountNotChanged, iCountEntities
dim iAllTables
dim iAllIndex
' Get the current active model
Set mdl = ActiveModel
call mainProcedure
'-----------------------------------------------------------------------------
' Main function
'-----------------------------------------------------------------------------
sub mainProcedure()
   If (mdl Is Nothing) Then
      MsgBox "There is no Active Model"
      exit sub
   End If
   If Not mdl.IsKindOf(PdPDM.cls_Model) Then
      MsgBox "This is not PDM"
      exit sub
   end if
   Set Fldr = ActiveDiagram.Parent
   RQ = MsgBox ("Starting at Folder: " & Fldr.Name & " Is Run ?", vbYesNo + vbInformation,"Confirmation")
   if RQ= VbNo then
      exit sub
   end if
  
   '------------------------------------
   iCountChanged = 0
   iCountEntities = 0
   iCountNotChanged = 0
   iAllTables = 0
   iAllIndex = 0
  
   removAllIndexes mdl
   output "_____Index Removal, Removed = " & iCountChanged & " in " & iCountEntities & " Entities. and not changed = " &  iCountNotChanged & ", all Tables = " & iAllTables & ", All Indexes= " & iAllIndex
   '------------------------------------
   iCountChanged = 0
   iCountEntities = 0
   iCountNotChanged = 0
   iAllTables = 0
   iAllIndex = 0
  
   creatRequiredIndexes mdl
   output "_____Index Creation, Created = " & iCountChanged & " in " & iCountEntities & " Entities. and not changed = " &  iCountNotChanged & ", all Tables = " & iAllTables & ", All Indexes= " & iAllIndex
   '------------------------------------
   iCountChanged = 0
   iCountEntities = 0
   iCountNotChanged = 0
   iAllTables = 0
   iAllIndex = 0
  
   removeEmptyIndexes mdl
   output "_____Empty Index Removal, Removed = " & iCountChanged & " in " & iCountEntities & " Entities. and not changed = " &  iCountNotChanged & ", all Tables = " & iAllTables & ", All Indexes= " & iAllIndex
 
 
End Sub
'-----------------------------------------------------------
' Creates indexes for specific general fields, or for specific table fields.
'-----------------------------------------------------------
Sub makeTableIndexes(ByVal tbl)
     MakePrimaryIndex(tbl)
  'any Table that has the following columns, should have them in an index:
  '-----------------------------------------------------------------------
  AddIndex tbl, "userNumber", True
  AddIndex tbl, "aName", False
  AddIndex tbl, "eName", False
  AddIndex tbl, "referenceNo", False
  AddIndex tbl, "dateG", False
  AddIndex tbl, "dateH", False
  AddIndex tbl, "deliveryDate", False
  AddIndex tbl, "deliveryDateH", False
  AddIndex tbl, "typeNo", False
  AddIndex tbl, "billTypeNo", False
  AddIndex tbl, "billToTypeNo", False
  AddIndex tbl, "thingNo", False
  AddIndex tbl, "barCode", False
  AddIndex tbl, "horizontalTreeNo", False
  AddIndex tbl, "buildingNo", False
  AddIndex tbl, "cashRegisterNo_BuildingNo", False
  'add index for specific tables:
  '-----------------------------------------------------------------------
     If tbl.Code <> "Account" Then
         'AddIndex tbl, "accountNo", False
         'AddIndex tbl, "Acc_accountNo", False
     End If
     If tbl.Code <> "Project" Then
         'AddIndex tbl, "projectNo", False
     End If
     If InStr(tbl.Code,"Invoice") >= 1 Then
         'output "Invoice: " & tbl.Code
         AddIndex tbl, "storeNo", False
         AddIndex tbl, "accountNo", False
         AddIndex tbl, "Acc_accountNo", False
     End If
     If tbl.Code = "Person" Then
         AddIndex tbl, "nationalityNo", True
         AddIndex tbl, "logger", True
         AddIndex tbl, "hafithaNo", False
         AddIndex tbl, "personelCardID", False
         AddIndex tbl, "telephone", False
         AddIndex tbl, "mobile", False
     End If
     If tbl.Code = "CodeObject" Then
         'AddIndex tbl, "orderNo", False
     End If
     If InStr(tbl.Code,"Item") >= 1 Then
         AddIndex tbl, "buySellTypeNo", False
         AddIndex tbl, "clientVendorNo", False
         AddIndex tbl, "itemLocationNo", False
         AddIndex tbl, "accountNo", False
         AddIndex tbl, "Acc_accountNo", False
     End If
    
         AddIndex tbl, "barCode", False
         AddIndex tbl, "serialNo", False
    
 End Sub
'-----------------------------------------------------------------------------
' This will recursivly search for all tables, and then add to them the required indexes
'-----------------------------------------------------------------------------
Sub creatRequiredIndexes(package)
     Dim tbl
     For Each tbl In package.Tables
          If tbl.IsShortcut = false Then
              iAllTables = iAllTables + 1
              makeTableIndexes(tbl)
          End If
     Next
     Dim subpackage
     For Each subpackage In package.Packages
         If Not subpackage.IsShortcut Then
             creatRequiredIndexes(subpackage)
         End If
     Next
End Sub
'-----------------------------------------------------------
' This will recursivly search for all tables, and then remove all old Inclusive indexes
'-----------------------------------------------------------
Sub removAllIndexes(package)
     Dim tbl
    
     For Each tbl In package.Tables
          If tbl.IsShortcut = false Then
              iAllTables = iAllTables + 1
              removeTableInclusiveIndexesB(tbl)
          End If
     Next
     Dim subpackage
     For Each subpackage In package.Packages
         If Not subpackage.IsShortcut Then
             removAllIndexes(subpackage)
         End If
     Next
 End Sub
'-----------------------------------------------------------
' Remove all Inclusive indexes from the table
'-----------------------------------------------------------
Sub removeTableInclusiveIndexesB(ByVal tbl_)
     Dim oPKIndex
     Dim oColect
     Dim sPrimaryIndexName
     Dim oInd
     dim iCountAddedIndexes
     Set oColect = CreateObject( "Scripting.Dictionary" )
     iCountAddedIndexes = 0
    
     sPrimaryIndexName = "PK_" & tbl_.Code 'Primary Index
    
     Set oPKIndex = getTableIndex(tbl_, sPrimaryIndexName)
    
     if  oPKIndex Is Nothing then
         output "not found: " & sPrimaryIndexName
         exit sub
     end if
    
     'Search in all other indexes, for columns included in the primary index:
     For Each oInd In tbl_.Indexes
         iAllIndex = iAllIndex + 1
         If oInd.IsShortcut = false Then
            If oInd.Code <> sPrimaryIndexName Then
               iCountEntities = iCountEntities + 1
                Dim isFoundAllColumns
                isFoundAllColumns = false
            
                If oInd.IndexColumns.Count > 0 Then
                   Dim oCol
                   For Each oCol In oInd.IndexColumns
                        Dim sIndexColName
                        dim oFoundCol
                        dim oColumn
                    
                        set oFoundCol = nothing
                        Set oFoundCol = getTableIndexColumn(oPKIndex, oCol.Code)
                       If oFoundCol  Is Nothing = false Then 'Check if the column is not in the Primary Index
                            oColect.Add oColect.count , oFoundCol
                            isFoundAllColumns = true
                       End If
                   Next
                end if
               
                If isFoundAllColumns Then
                    dim i
                    'output "oColect.Count= " & oColect.Count
                    For i = 0 to oColect.Count - 1
                        'output "num = " & i
                        if oColect.item(i) is nothing = false then
                           iCountChanged = iCountChanged + 1
                           oInd.IndexColumns.Remove oColect.item(i), True
                           'output "removed column from index:" & oInd.code & "." & oColect.item(i).code
                        end if
                     Next
                else
                     iCountNotChanged = iCountNotChanged + 1
                end if
            End If
         End If
     Next
      oColect.RemoveAll
 End Sub
'-----------------------------------------------------------
' Recursivly removes all empty indexes from all tables
'-----------------------------------------------------------
Sub removeEmptyIndexes(package)
     Dim tbl
    
     For Each tbl In package.Tables
          If tbl.IsShortcut = false Then
              iAllTables = iAllTables + 1
              removeTableEmptyIndexes(tbl)
          End If
     Next
     Dim subpackage
     For Each subpackage In package.Packages
         If Not subpackage.IsShortcut Then
             removeEmptyIndexes(subpackage)
         End If
     Next
 End Sub
'-----------------------------------------------------------
' Removes all empty indexes from the tables
'-----------------------------------------------------------
Sub removeTableEmptyIndexes(ByVal tbl_)
     Dim oPKIndex
     Dim oColect
     Dim sName
     Dim oInd
     dim iCountAddedIndexes
     dim isThereColumns
    
     Set oColect = CreateObject( "Scripting.Dictionary" )
     iCountAddedIndexes = 0
    
     isThereColumns = false
     'Search in all other indexes:
     For Each oInd In tbl_.Indexes
         iAllIndex = iAllIndex + 1
         If oInd.IsShortcut = false Then
           If oInd.IndexColumns.count <= 0 Then 'Check if the column is not in the Primary Index
                oColect.Add oColect.count , oInd
                isThereColumns = true
           End If
               
         End If
     Next
    
    If isThereColumns Then
      output "seen empty index:" & tbl_.code & "." & oColect.item(i).code
        dim i
        'output "oColect.Count= " & oColect.Count
        For i = 0 to oColect.Count - 1
            'output "num = " & i
            if oColect.item(i) is nothing = false then
               iCountChanged = iCountChanged + 1
               output "Removed empty index:" & tbl_.code & "." & oColect.item(i).code
               tbl_.Indexes.Remove oColect.item(i), True
            end if
         Next
    else
         iCountNotChanged = iCountNotChanged + 1
    end if
      oColect.RemoveAll
 End Sub
'-----------------------------------------------------------
 'Make the Primary Index as a Clustered index
'-----------------------------------------------------------
Sub MakePrimaryIndex( tbl_)
     Dim indPrimary ' As PdPDM.BaseIndex
    
     Set indPrimary = getTableIndex(tbl_, "PK_" & tbl_.Code)
    
     If indPrimary Is Nothing = false then
        If indPrimary.Clustered = False then
          indPrimary.Clustered = True
          output indPrimary.code
        end if
     End if
    
End Sub
'-----------------------------------------------------------
 'Make the indexName_ field in a unique Index
'-----------------------------------------------------------
Sub AddIndex( tbl_,  indexName_, isUnique)
     Dim oCol' As PdPDM.BaseColumn
     Dim oIndex' As PdPDM.BaseIndex
     Dim sPrefix' As String
    
     sPrefix= ""
     getTableColumn tbl_, indexName_, oCol
     If oCol Is Nothing Then
         'output "-Not found column: " & tbl_.code & "." & indexName_
         Exit Sub
     End If
     'output "+found column: " & tbl_.code & "." & indexName_
    
     If isUnique = True Then
         sPrefix = "AK" 'Alternate Key
         If CBool(oCol.GetAttribute("Mandatory")) = False Then
             oCol.SetAttribute "Mandatory", True
         End If
     Else
         sPrefix = "IX" 'Indexing
     End If
    
     Dim sName
     sName = sPrefix & "_" & tbl_.Code & "_" &  indexName_
    
     Set oIndex = getTableIndex(tbl_, sName)
     If oIndex Is Nothing Then
         iCountChanged = iCountChanged + 1
         Set oIndex = tbl_.Indexes.CreateNew()
         oIndex.Code = sName
         oIndex.Name = sName
     else
         'output "+found Index: " & tbl_.code & "." & oIndex.Code
         iCountNotChanged = iCountNotChanged + 1
     End If
     If isUnique = True And oIndex.Unique <> True Then oIndex.Unique = isUnique
     If oIndex.IndexColumns.Count <= 0 Then
         iCountChanged = iCountChanged + 1
         Dim oIndexCol' As PdPDM.IndexColumn
         Set oIndexCol = oIndex.IndexColumns.CreateNew()
         With oIndexCol
             .Column = oCol
         End With
         'output "Index created:" & oIndex.Code & ", col:" & oCol.Code
     End If
End Sub
'-----------------------------------------------------------
' Gets the first index object of the table
'-----------------------------------------------------------
Function getTableIndex( tbl_,  name_)' As PdPDM.BaseIndex
   dim oIndex' As PdPDM.BaseIndex
     For Each oIndex In tbl_.Indexes
         If oIndex.Code = name_ Then
             Set getTableIndex = oIndex
             exit Function
         End If
     Next
     Set getTableIndex = Nothing
End Function
'-----------------------------------------------------------
' Gets the index that contains the columnCodeName_
'-----------------------------------------------------------
 Function getTableIndexColumn( oIndex_,  columnCodeName_)' As PdPDM.IndexColumn
 dim oColumn' As PdPDM.IndexColumn
     For Each oColumn In oIndex_.IndexColumns
         If oColumn.Code = columnCodeName_ Then
             set getTableIndexColumn = oColumn
             exit Function
         End If
     Next
     set getTableIndexColumn =  Nothing
 End Function
'-----------------------------------------------------------
' Gets the table columnCodeName_ object
'-----------------------------------------------------------
Sub getTableColumn( tbl_,  columnCodeName_, ByRef retVal_ )' As PdPDM.BaseColumn
     dim col
    
     For Each col In tbl_.Columns
         If col.Code = columnCodeName_ Then
             set retVal_ = col
             'output "++ found col: " & col.Code
             exit sub
         End If
     Next
    
     set retVal_ =  Nothing
 End sub
To report this post you need to login first.

Be the first to leave a comment

You must be Logged on to comment or reply to a post.

Leave a Reply