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
