API CellGet Function

Please be aware that this code is not some of my better work, its from about 2 years ago from a pet project of mine.

Enjoy.

In Sumary this code connects to a server to get a value from a Cube, then disconnects. (This is not very efficient but shows all fundamentals of TM1 API Development – pre .net).

Function DBR(ByVal server As String, ByVal sClientId As String, ByVal sPassword As String, ByVal Cube As String, ByVal Elements As String) As String

Dim sServerName As String
sServerName = server

Dim sElements() As String
Dim iElements() As Long
Dim vbOK As Long
Dim pGeneral As Long

Dim hElementPool As Long
Dim i As Long
Dim voserver As Long
Dim hCubePool As Long, voTemp As Long
Dim hValue As Long
Dim iResult As Long, sResult As String * 100
Dim vType As Long, ilength As Long
Dim hDimensionPool As Long
Dim viDimCount As Long
Dim iDimCount As Long
Dim voCube As Long
Dim pElements As Long
Dim voDim As Long

Dim NamePool As Long, voElemName As Long

Dim vSub() As Long

If InStr(1, Elements, “|”) = 0 Then
DBR = “Key invalid”
Exit Function
End If
If sServerName = “” Then
DBR = “Server not found”
Exit Function
End If

‘———————————————————–
‘ Check if already connected by retrieving Server handle.
‘———————————————————–

pGeneral = TM1ValPoolCreate(hUser)
voserver = TM1SystemServerHandle(hUser, sServerName)

‘if( TM1ValType( hUser, voServer ) == TM1ValTypeError() )
If voserver = 0 Then

‘——————————————————–
‘ Connect to the database
‘——————————————————–

voserver = TM1SystemServerConnect(pGeneral, TM1ValString(pGeneral, sServerName, 100), TM1ValString(pGeneral, sClientId, 100), TM1ValString(pGeneral, sPassword, 100))

If TM1ValType(hUser, voserver) = TM1ValTypeError() Then
Debug.Print “Cannot connect to server”
End If
End If

‘——————————————————
‘ Split the elements into an array
‘——————————————————
sElements = Split(Elements, “|”, -1, vbTextCompare)
ReDim iElements(UBound(sElements)) As Long
ReDim vDim(0 To UBound(sElements)) As Long
ReDim hDim(0 To UBound(sElements)) As Long
ReDim vEle(0 To UBound(sElements)) As Long

NamePool = TM1ValPoolCreate(hUser)

hDimensionPool = TM1ValPoolCreate(hUser)
hElementPool = TM1ValPoolCreate(hUser)
hCubePool = TM1ValPoolCreate(hUser)

voTemp = TM1ObjectListHandleByNameGet(hCubePool, voserver, TM1ServerCubes(), TM1ValString(pGeneral, Cube, Len(Cube)))
voCube = TM1ValPoolGet(hCubePool, 0)
If TM1ValObjectCanRead(hUser, voCube) <> 0 Then

iDimCount = UBound(sElements) + 1

For i = 0 To iDimCount – 1
vEle(i) = TM1ValPoolCreate(hUser)
vDim(i) = TM1ValPoolCreate(hUser)
Next

For i = 0 To iDimCount – 1
voTemp = TM1ObjectListHandleByIndexGet(vDim(i), voCube, TM1CubeDimensions(), TM1ValIndex(pGeneral, i + 1))
hDim(i) = TM1ValPoolGet(vDim(i), 0)

If TM1ValObjectCanRead(hUser, hDim(i)) = 0 Then
DBR = “Element Dimension not Valid”
Exit Function
End If

voTemp = TM1ObjectListHandleByNameGet(vEle(i), hDim(i), TM1DimensionElements(), TM1ValString(pGeneral, sElements(i), Len(sElements(i))))
iElements(i) = TM1ValPoolGet(vEle(i), 0)

If TM1ValObjectCanRead(hUser, iElements(i)) = 0 Then
DBR = “Element Name Invalid”
Exit Function
End If

Next i

Dim MyvArray As Long
MyvArray = TM1ValArray(pGeneral, iElements, i)

For i = 0 To iDimCount – 1
TM1ValArraySet MyvArray, iElements(i), (i + 1)
Next i

‘Final function call ********** TM1CubeCellValueGet ***********
hValue = TM1CubeCellValueGet(pGeneral, voCube, MyvArray)

vType = TM1ValType(hUser, hValue)
Select Case vType

Case TM1ValTypeReal
iResult = TM1ValRealGet(hUser, hValue)
DBR = iResult

Case TM1ValTypeString
Call TM1ValStringGet_VB(hUser, hValue, sResult, 100)
DBR = Trim(sResult)

Case TM1ValTypeIndex
iResult = TM1ValIndexGet(hUser, hValue)
DBR = iResult

Case TM1ValTypeBool
iResult = TM1ValBoolGet(hUser, hValue)
DBR = iResult

Case TM1ValTypeObject
MsgBox (“Object Returned – Error”)

Case TM1ValTypeError
Call TM1ValErrorString_VB(hUser, hValue, sResult, 100)
DBR = Trim(sResult)

Case TM1ValTypeArray
MsgBox (“Array Returned – Error”)

End Select

‘—————————————————
‘ Disconnect from the database
‘—————————————————

vbOK = TM1SystemServerDisconnect(pGeneral, voserver)

If TM1ValBoolGet(hUser, vbOK) = 1 Then
Debug.Print “Disconnect from server passed”
Else
Debug.Print “Disconnect from server failed”
End If

End If

For i = 0 To iDimCount – 1
TM1ValPoolDestroy (vEle(i))
TM1ValPoolDestroy (vDim(i))
Next

TM1ValPoolDestroy (hElementPool)
TM1ValPoolDestroy (hCubePool)
TM1ValPoolDestroy (hDimensionPool)
TM1ValPoolDestroy (pGeneral)

End Function

You might also like