Automation of the removal of unwanted categories

[dwood09]

Scenario: 
* Model that is mostly free of categories, ie you are not employing the "move" function, but are relying on the re-load of data and structures as run time.

* Some categories are however requried to remain, eg special cats, manual levels, suppressed, excluded categories, categories with manual ordering details etc

* once you've finished the model you want to clean it of all unwanted categories, without doing it manually


Solution:
* the following process traverses the dimensions, levels and cats of a model and removed all categories that are not marked as required.  Ie it looks for a string within the description of each category. 

* If the category is not required, and is not the parent of a category that is required then it will be removed from the model.

* the process then saves the model as an "mdl", re-opens it, applies the database logon and password and then re-saves back to pyi.

The result is a pyi that only has the required categories.  The old model is also saved with a timestamp ... just in case ...


NB:
* Build using VB.NET
* works on 7.3 models ... not tested with 7.1, but should be ok.

cheers,
DW


Module Module1

   Dim iCatsRemoved As Int32
   Dim iCatsRetained As Int32

Sub StripOutCats()
   '***** SET THESE VARIABLES ****
   Const sInPath As String = "u:\bi\forecast\ModelsToBuild\zbackup\summary P and L\" ' must end in \
   Const sInFile As String = "01-summary p and l.pyi"
   Const sAMlogon As String = "" 'logon for access manager
   Const sAMpwd As String = "" 'password for access manager
   Const sUserClass As String = "Root User Class" 'user class for Access Manager
   Const sOutputPath As String = "c:\"   ' path for temporary output file
   Const sPYIlogon As String = "dbaselogon" ' logon required to be embeded within Transformer model
   Const sPYIpassword As String = "dbasepwd" ' password required to be embeded within Transformer model
   Const sFlag As String = "retain=1" 'string to find within the description for categories to retain

   '***

   Dim iDim As Integer
   Dim iDdown As Integer
   Dim iCat As Integer
   Dim objTranApp As Object 'transformer application object
   Dim objModel As Object ' model object
   Dim objDimension As Object ' dim object
   Dim objDrillDown As Object ' drilldown object
   Dim objCat As Object ' Category object
   Dim iDataSourceId As Integer
   Dim sNewFilePath As String
   Dim iSignons As Integer
   Dim bSave As Boolean
   Dim obFS As Object 'FileSystem Object
   Dim bErr As Boolean

   Dim bCont As Boolean
   Dim sErr As String
   Dim sName As String
   Dim iModelId As Integer
   Dim bComplete As Boolean

   'open transformer
   bComplete = False

   sName = Left(sInFile, Len(sInFile) - 4)
   objTranApp = CreateObject("CognosTransformer.Application")
   objModel = objTranApp.OpenModel(sInPath & sInFile) ', sAMlogon, sAMpwd, sUserClass)

   'scroll thru each dim
   For iDim = 1 To objModel.Dimensions.Count
      objDimension = objModel.Dimensions(iDim)

      For iDdown = 1 To objDimension.drilldowns.Count
         objDrillDown = objDimension.drilldowns(iDdown)

         bComplete = False

         While Not bComplete
            If objDrillDown.categories.Count > 0 Then
               For iCat = objDrillDown.categories.Count To 1 Step -1
                  objCat = objDrillDown.categories(iCat)

                  If Not TraverseDim(objCat, "", True, sFlag) Then 'not to be retained
                     objCat.Delete()
                     iCatsRemoved = iCatsRemoved + 1
                     bComplete = False
                  Else
                     bComplete = True
                     iCatsRetained = iCatsRetained + 1
                  End If
               Next iCat
            Else
               bComplete = True
            End If
         End While
      Next iDdown

   Next iDim

   'scroll thru each level and cat

   If iCatsRemoved > 0 Then
      objModel.Update()
      objModel.Save()
   End If

   bErr = False

   Try
      sNewFilePath = sInPath & Left(sInFile, Len(sInFile) - 3) & "mdl"
      objModel.SaveAs(sNewFilePath)

   Catch objException As Exception
      bErr = True
      MsgBox("Unable to save the file as mdl.  Msg: " & objException.ToString())
   End Try

   If Not bErr Then
      bSave = False

      'open the new mdl
      objModel = objTranApp.OpenModel(sNewFilePath)

      For iSignons = 1 To objModel.signons.Count()
         If objModel.signons(iSignons).userid = sPYIlogon Then
            objModel.signons(iSignons).Password = sPYIpassword
            objModel.signons(iSignons).PromptForPassword = False
            objModel.signons(iSignons).Update()
            bSave = True
         Else
            MsgBox("You will need to set the password for signon " & objModel.signons(iSignons).Name)
         End If
      Next iSignons

      If bSave Then
         'save as pyi
         objModel.Update()
         objModel.SaveAs(sOutputPath & Left(sInFile, Len(sInFile) - 3) & "pyi")
      End If

      objModel.Close()
      objModel = Nothing

      'delete mdl
      obFS = CreateObject("Scripting.FileSystemObject")
      obFS.DeleteFile(sNewFilePath)

      'move pyi
      bErr = False
      Try
         'backup existing pyi
         obFS.MoveFile(sInPath & sInFile, sInPath & Format(Now(), "yyyyMMdd HHmm") & " - " & sInFile)

    'copy in new file
         obFS.MoveFile(sOutputPath & Left(sInFile, Len(sInFile) - 3) & "pyi", sInPath & sInFile)

      Catch objException As Exception
         bErr = True
         MsgBox("Could not move the file from " & sOutputPath & ".  Please move yourself.")
      End Try
   Else
      objModel.Close()
      objModel = Nothing
   End If 'end test for err on save as mdl

   MsgBox("Categories Removed: " & iCatsRemoved & Chr(13) & "Categories Retained: " & iCatsRetained)
End Sub



Function TraverseDim(ByVal objInCat As Object, ByVal sOutSheet As String, ByVal bInTraverse As Boolean, ByVal sInFlag As String)
   Dim bCont As Boolean
   Dim sDesc As String
   Dim iCat As Int32
   Dim objCat As Object
   Dim iCurrCount As Int32
   Dim bResult As Boolean

   bCont = True
   bResult = False

   'check this cat for removal

   sDesc = Trim(objInCat.Description)

   If InStr(1, sDesc, sInFlag, CompareMethod.Text) > 0 Then
      'check cat at this level
      bResult = True
   End If

   iCurrCount = objInCat.childcategories.Count

   If iCurrCount > 0 Then
      For iCat = iCurrCount To 1 Step -1

         Try
            objCat = objInCat.childcategories(iCat)
         Catch objException As Exception
            Exit For
         End Try

         'traverse to the next level

         If TraverseDim(objCat, "", True, sInFlag) Then 'to be retained
            bResult = True
            iCatsRetained = iCatsRetained + 1

         Else
            objCat.Delete()
            iCatsRemoved = iCatsRemoved + 1
         End If

      Next iCat
   End If

   TraverseDim = bResult
End Function

End Module

[Darek]

What a nice piece of work ... Great code.