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
What a nice piece of work ... Great code.