Author Topic: Automation of the removal of unwanted categories  (Read 2779 times)

Offline dwood09

  • Global Moderator
  • Senior Member
  • *****
  • Join Date: Jul 2005
  • Posts: 60
  • Forum Citizenship: +9/-0
Automation of the removal of unwanted categories
« on: 28 Sep 2005 09:51:45 pm »
* 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

* 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 ...

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


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
                     iCatsRemoved = iCatsRemoved + 1
                     bComplete = False
                     bComplete = True
                     iCatsRetained = iCatsRetained + 1
                  End If
               Next iCat
               bComplete = True
            End If
         End While
      Next iDdown

   Next iDim

   'scroll thru each level and cat

   If iCatsRemoved > 0 Then
   End If

   bErr = False

      sNewFilePath = sInPath & Left(sInFile, Len(sInFile) - 3) & "mdl"

   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
            bSave = True
            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.SaveAs(sOutputPath & Left(sInFile, Len(sInFile) - 3) & "pyi")
      End If

      objModel = Nothing

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

      'move pyi
      bErr = False
         '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
      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

            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

            iCatsRemoved = iCatsRemoved + 1
         End If

      Next iCat
   End If

   TraverseDim = bResult
End Function

End Module


  • Guest
Re: Automation of the removal of unwanted categories
« Reply #1 on: 03 Oct 2005 09:38:42 pm »
What a nice piece of work ... Great code.