TM1 object dependency checker - VB help needed

[Gareth Soo]

Hi all, I have a bit of code here I would like to share and possibly get some help with.

I have created an Excel VB-based dependency checker that shows which cubes are related to which processes and rules and another process which shows which dimensions are related to which cubes, processes and rules. The idea is that it can highlight which dimensions are redundent and identify which objects need to be updated if you want to change or delete an object.

Here is the vb process that populates the dependencies for cubes (data directory needs to be updated before running):

Code: Select all

Sub Cube_to_ProRux()

ReDim strCubeArray(1 To 200)
ReDim strCubesArray(1 To 200, 1 To 4, 1 To 200)
Dim StrSorted()
i = 1
 
    Set FSO = CreateObject("Scripting.FileSystemObject")
    
'##################### Update Server Directory Accordingly ############################
    directory = "\\server\d$\Cognos\TM1 Servers\data\"
    
    'Create cube array
    Set F = FSO.getFolder(directory)
    Set ff = F.Files
    
'Cells(1, 4) = Now
       
    For Each f1 In ff
        If f1.Type = "CUB File" Then
        
            strCubeArray(i) = Left(f1.Name, Len(f1.Name) - 4)
            strCubesArray(i, 1, 1) = Left(f1.Name, Len(f1.Name) - 4)
            'Cells(i, 1) = Left(f1.Name, Len(f1.Name) - 4)
            
            strCubesArray(i, 2, 1) = "Process Refences"
            strCubesArray(i, 3, 1) = "Rule Refences"
        i = i + 1
        End If
    Next
 
    Set TextStream = Nothing
    Set ff = Nothing
    Set FSO = Nothing
    Set F = Nothing
    
    i = i - 1
    ReDim Preserve strCubeArray(1 To i)
        
    'Search pro files for cube references
    Set FSO = CreateObject("Scripting.FileSystemObject")
    Set F = FSO.getFolder(directory)
    Set ff = F.Files
       
    For Each f1 In ff
        Select Case f1.Type
'##################### PRO File ############################
            Case "PRO File"
        
                Set TextStream = FSO.OpenTextFile(directory & f1.Name, 1, False, -2)
                strline = TextStream.readall
                  
                   For i = 1 To UBound(strCubeArray)
                        If (InStr(strline, strCubeArray(i)) > 0) Then
                            For j = 2 To UBound(strCubesArray)
                                If strCubesArray(i, 2, j) = "" Then
                                    strCubesArray(i, 2, j) = Left(f1.Name, Len(f1.Name) - 4)
                                    Exit For
                                End If
                            Next
                        End If
                    Next
 
                Set TextStream = Nothing
                
'##################### RUX file ############################
            Case "RUX File"
            
                 Set TextStream = FSO.OpenTextFile(directory & f1.Name, 1, False, -2)
                strline = TextStream.readall
                  
                   For i = 1 To UBound(strCubeArray)
                        If (InStr(strline, strCubeArray(i)) > 0) Then
                            For j = 2 To UBound(strCubesArray)
                                If strCubesArray(i, 3, j) = "" Then
                                    strCubesArray(i, 3, j) = Left(f1.Name, Len(f1.Name) - 4)
                                    Exit For
                                End If
                            Next
                        End If
                    Next
 
                Set TextStream = Nothing
                
            
        End Select
    Next
 
    Set TextStream = Nothing
    Set ff = Nothing
    Set FSO = Nothing
    Set F = Nothing

'Populate array
x = 1
For i = 1 To UBound(strCubeArray)
Cells(x, 1) = strCubeArray(i)
Cells(x, 1).Font.Bold = True
    If (strCubesArray(i, 2, 2) & strCubesArray(i, 3, 2) = "") Then
        x = x + 1
    Else
        For j = 2 To 3
            If (strCubesArray(i, j, 2) <> "") Then
                st = x + 1
                k = 1
                While (strCubesArray(i, j, k) <> "")
                   Cells(x, 2) = strCubesArray(i, j, k)
                    If (k = 1) Then
                        Cells(x, 2).Font.Underline = xlUnderlineStyleSingle
                    End If
                    k = k + 1
                    x = x + 1
                Wend
                Range("A" & st & ":A" & x - 1).Select
                Selection.Rows.Group
            End If
        Next
    End If
Next

End Sub

and the process that generates dependencies for dimensions:

Code: Select all

Sub Dim_to_Cube()

ReDim strCubeArray(1 To 200)
ReDim strCubesArray(1 To 200, 1 To 4, 1 To 200)
Dim StrSorted()
i = 1
 
    Set FSO = CreateObject("Scripting.FileSystemObject")
    
'##################### Update Server Directory Accordingly ############################
directory = "\\server\d$\Cognos\TM1 Servers\data\"
    
    'Create cube array
    Set F = FSO.getFolder(directory)
    Set ff = F.Files
       
    For Each f1 In ff
        If f1.Type = "DIM File" Then
        
            strCubeArray(i) = Left(f1.Name, Len(f1.Name) - 4)
            strCubesArray(i, 1, 1) = Left(f1.Name, Len(f1.Name) - 4)
        i = i + 1
        End If
    Next
 
    Set TextStream = Nothing
    Set ff = Nothing
    Set FSO = Nothing
    Set F = Nothing
    
    i = i - 1
    ReDim Preserve strCubeArray(1 To i)
    'Search pro files for cube references
    Set FSO = CreateObject("Scripting.FileSystemObject")
    Set F = FSO.getFolder(directory)
    Set ff = F.Files
       
    For Each f1 In ff
        Select Case f1.Type
'##################### CUB File ############################
            Case "CUB File"
        
                Set TextStream = FSO.OpenTextFile(directory & f1.Name, 1, False, -2)
                
                For k = 1 To 5
                If (TextStream.AtEndOfStream) Then
                    Exit For
                End If
                strline = TextStream.readline
                  
                   For i = 1 To UBound(strCubeArray)
                        strCubesArray(i, 2, 1) = "Cube Refs"
                        If (InStr(strline, strCubeArray(i)) > 0) Then
                            For j = 2 To UBound(strCubesArray)
                                If strCubesArray(i, 2, j) = "" Then
                                    strCubesArray(i, 2, j) = Left(f1.Name, Len(f1.Name) - 4)
                                    Exit For
                                End If
                            Next
                        End If
                    Next
                    
                Next
                
'##################### PRO File ############################
            Case "PRO File"
        
                Set TextStream = FSO.OpenTextFile(directory & f1.Name, 1, False, -2)
                strline = TextStream.readall
                  
                   For i = 1 To UBound(strCubeArray)
                   strCubesArray(i, 3, 1) = "Process Refs"
                        If (InStr(strline, strCubeArray(i)) > 0) Then
                            For j = 2 To UBound(strCubesArray)
                                If strCubesArray(i, 3, j) = "" Then
                                    strCubesArray(i, 3, j) = Left(f1.Name, Len(f1.Name) - 4)
                                    Exit For
                                End If
                            Next
                        End If
                    Next
 
                Set TextStream = Nothing
                
'##################### RUX file ############################
            Case "RUX File"
            
                 Set TextStream = FSO.OpenTextFile(directory & f1.Name, 1, False, -2)
                strline = TextStream.readall
                  
                   For i = 1 To UBound(strCubeArray)
                   strCubesArray(i, 4, 1) = "Rule Refs"
                        If (InStr(strline, strCubeArray(i)) > 0) Then
                            For j = 2 To UBound(strCubesArray)
                                If strCubesArray(i, 4, j) = "" Then
                                    strCubesArray(i, 4, j) = Left(f1.Name, Len(f1.Name) - 4)
                                    Exit For
                                End If
                            Next
                        End If
                    Next
 
 
                Set TextStream = Nothing
        End Select
    Next
 
    Set TextStream = Nothing
    Set ff = Nothing
    Set FSO = Nothing
    Set F = Nothing

'Populate array
x = 1
For i = 1 To UBound(strCubeArray)
Cells(x, 1) = strCubeArray(i)
Cells(x, 1).Font.Bold = True
    If (strCubesArray(i, 2, 2) & strCubesArray(i, 3, 2) & strCubesArray(i, 4, 2) = "") Then
        x = x + 1
    Else
        For j = 2 To 4
            If (strCubesArray(i, j, 2) <> "") Then
                st = x + 1
                k = 1
                While (strCubesArray(i, j, k) <> "")
                   Cells(x, 2) = strCubesArray(i, j, k)
                    If (k = 1) Then
                        Cells(x, 2).Font.Underline = xlUnderlineStyleSingle
                    End If
                    k = k + 1
                    x = x + 1
                Wend
                Range("A" & st & ":A" & x - 1).Select
                Selection.Rows.Group
            End If
        Next
    End If
Next

End Sub

Now, it works for 95% of references but some dimension to cube references aren't being picked up. To read the cube files, im using:

Set TextStream = FSO.OpenTextFile(directory & f1.Name, 1, False, -2)
strline = TextStream.readline

I have tried ?strline to debug the problem cube and it outputs very differetly to what working cubes and the physical cube contains.

Ie. "?strline =
01,100
562,"SUBSET"
586,"}clients"
585,"}clients""
"

but the first line of the physical cube is:
"x
exchange_type version
from_currency to_currency"
"

I am at a loss as to why it outputs differently, and I thought it would consistently work (or fail). Does anyone have any ideas why its not reading the file correctly? I have tried different types of encrytion on the vb side (unicode etc) but I thought all TM1 cube files would be encoded and read the same. Im using 9.52 and pre as well as post unicode cubes work.

thanks in advance
Gareth

[Harvey]

You could try the "Documenter" feature of the Flow Model Packager. It does something similar to what you are attempting, without you writing any code.

It's in beta at the moment, so if you are interested in helping me get it to production, let me know and I'll include you in the beta program.

[Marcus Scherer]

Welcome Gareth,
I can't answer your question, but can give you some feedback. The Sub Dim_to_Cube () works very reliable as long as the search in *.pro and *.rux files is commented out. I suppose your problem is the *.pro an *.rux part and filling of the array and overriding existing content. With those two checks in addition the dimension list gets unordered ( I suppose dimensions in col. A shall stay sorted ascending? ) and false results in col. B appear.

Your code will be very useful to me in the future if I have to work on a model that somebody else set up to get a quick overview of the most important relationships.

[Wim Gielis]

Hello Gareth

- Why reading out .cub files, if a function like tabdim can return the dimensions for a cube?
- Watch out for false positives. For example, a dimension name that is found within the left area of a rules statement.
- Watch out for cases where you do not spot the hardcoded names. For example, concatenations in .rux or .pro files, or variables/CellGet statements, and so on.

Don't get me wrong, it could be useful for the main relationships in a TM1 model.
I only want to say: do not hope to write code that catches all occurrences.
If you would have the perfect solution (code-wise), please drop me an email

[Gareth Soo]

Thanks for the suggestion Wim, I have updated the code with TABDIM and it works much better now:

Code: Select all

Sub Dim_to_Cube()

ReDim strCubeArray(1 To 500)
ReDim strDimArray(1 To 500, 1 To 50)
ReDim StrCubesArray(1 To 500, 1 To 4, 1 To 500)
Dim StrSorted()
i = 1
    Set FSO = CreateObject("Scripting.FileSystemObject")
    
'##################### Update Server Name and Directory Accordingly ############################
    server = "server name"
    directory = "\\server\d$\Cognos\TM1 Servers\\data\"
    
    'Create cube array
    Set F = FSO.getFolder(directory)
    Set ff = F.Files
       
    For Each f1 In ff
        If f1.Type = "DIM File" Then
        
            strCubeArray(i) = Left(f1.Name, Len(f1.Name) - 4)
            StrCubesArray(i, 1, 1) = Left(f1.Name, Len(f1.Name) - 4)
        i = i + 1
        End If
    Next
 
    Set TextStream = Nothing
    Set ff = Nothing
    Set FSO = Nothing
    Set F = Nothing
    
    i = i - 1
    ReDim Preserve strCubeArray(1 To i)
    
'##################### Cube Refs ############################
NumCubes = Application.Run("DIMSIZ", server & ":}cubes")
For j = 1 To NumCubes
    cube = Application.Run("DIMNM", server & ":}cubes", j)
    strDimArray(j, 1) = cube
    
    i = 1
    dimension = Application.Run("TABDIM", server & ":" & cube, i)
    While (dimension <> "")
        strDimArray(j, i + 1) = dimension
        i = i + 1
        dimension = Application.Run("TABDIM", server & ":" & cube, i)
    Wend
Next

i = 1
While (strDimArray(i, 1) <> "")
j = 2
    While (strDimArray(i, j) <> "")
       For k = 1 To UBound(strCubeArray)
            If (strDimArray(i, j) = strCubeArray(k)) Then
                StrCubesArray(k, 2, 1) = "Cube Refs"
                l = 2
                While (StrCubesArray(k, 2, l) <> "")
                    l = l + 1
                Wend
                StrCubesArray(k, 2, l) = strDimArray(i, 1)
            End If
        Next
        j = j + 1
            
    Wend
    i = i + 1
Wend
'#######################################################

    
    'Search data directory for cube references
    Set FSO = CreateObject("Scripting.FileSystemObject")
    Set F = FSO.getFolder(directory)
    Set ff = F.Files
       
    For Each f1 In ff
        Select Case f1.Type
'##################### PRO File ############################
            Case "PRO File"
        
                Set TextStream = FSO.OpenTextFile(directory & f1.Name, 1, False, -2)
                strline = TextStream.readall
                  
                   For i = 1 To UBound(strCubeArray)
                   StrCubesArray(i, 3, 1) = "Process Refs"
                        If (InStr(strline, strCubeArray(i)) > 0) Then
                            For j = 2 To UBound(StrCubesArray)
                                If StrCubesArray(i, 3, j) = "" Then
                                    StrCubesArray(i, 3, j) = Left(f1.Name, Len(f1.Name) - 4)
                                    Exit For
                                End If
                            Next
                        End If
                    Next
 
                Set TextStream = Nothing
                
'##################### RUX file ############################
            Case "RUX File"
            
                 Set TextStream = FSO.OpenTextFile(directory & f1.Name, 1, False, -2)
                strline = TextStream.readall
                  
                   For i = 1 To UBound(strCubeArray)
                   StrCubesArray(i, 4, 1) = "Rule Refs"
                        If (InStr(strline, strCubeArray(i)) > 0) Then
                            For j = 2 To UBound(StrCubesArray)
                                If StrCubesArray(i, 4, j) = "" Then
                                    StrCubesArray(i, 4, j) = Left(f1.Name, Len(f1.Name) - 4)
                                    Exit For
                                End If
                            Next
                        End If
                    Next
 
                Set TextStream = Nothing
        End Select
    Next
 
    Set TextStream = Nothing
    Set ff = Nothing
    Set FSO = Nothing
    Set F = Nothing

'Populate array
x = 1
For i = 1 To UBound(strCubeArray)
Cells(x, 1) = strCubeArray(i)
Cells(x, 1).Font.Bold = True
    If (StrCubesArray(i, 2, 2) & StrCubesArray(i, 3, 2) & StrCubesArray(i, 4, 2) = "") Then
        x = x + 1
    Else
        For j = 2 To 4
            If (StrCubesArray(i, j, 2) <> "") Then
                st = x + 1
                k = 1
                While (StrCubesArray(i, j, k) <> "")
                   Cells(x, 2) = StrCubesArray(i, j, k)
                    If (k = 1) Then
                        Cells(x, 2).Font.Underline = xlUnderlineStyleSingle
                    End If
                    k = k + 1
                    x = x + 1
                Wend
                Range("A" & st & ":A" & x - 1).Select
                Selection.Rows.Group
            End If
        Next
    End If
Next

End Sub

I preferred reading .cub files as it doesn't require a login to TM1 and it puts less strain on the server, but it didn't take long at all to populate all cubes/dimensions into an array so I am happy with how it turned out.

Your right in saying it won't catch all occurrences but I couldn't think of any cases where we do this. I guess it helps to have a working knowledge of the system when running it but it was suppose to be a basic tool for managing changes and dimension clean-up. Something like http://www.qubedocs.com/ would be more appropiate for a comprehensive documentation/management system i'd imagine.

Marcus, can you post an image or example of the error you are having? It seems to be working fine when I run it with or without the pro and rux references. I wouldn't think the dimension order should change as it is created from the start and isn't modified until it is populated into the spreadsheet.

[Marcus Scherer]

Hi Gareth,
I apologize, the order is right, I probably didn't delete the result set before executing the code a second time. But in fact the result set is different when executing it several times (see example in attachment with two consecutive runs, server not running). For the purpose you mentioned it is very effective though.