Columns object not Drillingdown after 5 levels in PowerPlay

[giridharkannan]

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(y).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