am writing a macro in PowerPlay to extract the hirarchy structure of a cube. The problem which am facing is that the column obj is not drilling down after 4 levels even though it can be drilled-down.
plz help me
here is the code...
Declare Function Tree_Extractor(PPCol as Object)
Sub Main()
On Error GoTo Debu
Dim objPPRep as Object
Dim objCatList as Object
Dim objPPDim as Object
Dim objPPCol as Object
Dim s1,s2 as String
Set objPPRep = CreateObject("CognosPowerPlay.Report")
objPPRep.New "xxx.mdc", -1
Open "tree.xml" for Output as #1
Write #1, "<root>"
For x = 1 to objPPRep.DimensionLine.Count - 1
Set objPPDim = objPPRep.DimensionLine.Item(x)
s1 = objPPDim.Name
MsgBox s1
Write #1, "<" & s1 & ">"
For y = 1 to objPPDim.Count
Set objCatList = objPPRep.CategoryList
s2 = objPPDim.Children.Item.Name
Write #1, "<" & s2 & ">"
objCatList.Add 1,s1,s2
objPPRep.Columns.Add objCatList
Set objPPCol = objPPRep.Columns
Call Tree_Extractor(objPPCol)
objPPDim.ChangeToTop
objCatList.Remove
Set objCatList = Nothing
one:
Write #1, "</ " & s2 & ">"
Next y
Write #1, "</ " & s1 & ">"
Next x
MsgBox "Finished"
Write #1,"</ root>"
Exit Sub
Debu:
Resume one
End Sub
Function Tree_Extractor(PPCol as object)
On Error GoTo Debugger
Dim i,f as Integer
Dim CatList as Object
f = 0
For i = 1 to PPCol.Count
If PPCol.Item(i).Children <> 0 Then
f = 1
Write #1,"<" & PPCol.Item(i).Name & ">"
Call Tree_Extractor(PPCol.Item(i).Children)
End If
done:
If f = 1 Then
f = 0
Write #1,"</ " & PPCol.Item(i).Name & ">"
Else
Write #1, PPCol.Item(i).Name
End If
Next i
Exit Function
Debugger:
Resume done
End Function
plz help me
here is the code...
Declare Function Tree_Extractor(PPCol as Object)
Sub Main()
On Error GoTo Debu
Dim objPPRep as Object
Dim objCatList as Object
Dim objPPDim as Object
Dim objPPCol as Object
Dim s1,s2 as String
Set objPPRep = CreateObject("CognosPowerPlay.Report")
objPPRep.New "xxx.mdc", -1
Open "tree.xml" for Output as #1
Write #1, "<root>"
For x = 1 to objPPRep.DimensionLine.Count - 1
Set objPPDim = objPPRep.DimensionLine.Item(x)
s1 = objPPDim.Name
MsgBox s1
Write #1, "<" & s1 & ">"
For y = 1 to objPPDim.Count
Set objCatList = objPPRep.CategoryList
s2 = objPPDim.Children.Item.Name
Write #1, "<" & s2 & ">"
objCatList.Add 1,s1,s2
objPPRep.Columns.Add objCatList
Set objPPCol = objPPRep.Columns
Call Tree_Extractor(objPPCol)
objPPDim.ChangeToTop
objCatList.Remove
Set objCatList = Nothing
one:
Write #1, "</ " & s2 & ">"
Next y
Write #1, "</ " & s1 & ">"
Next x
MsgBox "Finished"
Write #1,"</ root>"
Exit Sub
Debu:
Resume one
End Sub
Function Tree_Extractor(PPCol as object)
On Error GoTo Debugger
Dim i,f as Integer
Dim CatList as Object
f = 0
For i = 1 to PPCol.Count
If PPCol.Item(i).Children <> 0 Then
f = 1
Write #1,"<" & PPCol.Item(i).Name & ">"
Call Tree_Extractor(PPCol.Item(i).Children)
End If
done:
If f = 1 Then
f = 0
Write #1,"</ " & PPCol.Item(i).Name & ">"
Else
Write #1, PPCol.Item(i).Name
End If
Next i
Exit Function
Debugger:
Resume done
End Function