TM1 Forum

Code: Select all

Private Sub Form_Load()
Dim sServerName As String
Dim sUsername As String
Dim sPassword As String
Dim hUserHandle As Long
Dim pPoolHandle As Long
Dim vPassword, vServerName, vUserName As Long
Dim vStringLength As Long
Dim RetVal As String * 75


TM1APIInitialize
hUser = TM1SystemOpen()
TM1SystemAdminHostSet hUser, "rjordon"
pPoolHandle = TM1ValPoolCreate(hUser)
'
' We have to take the strings containing the login information (such as the
' user name and password) and turn them into TM1 value capsules.First
' establish the maximum length of the string as 10 characters.
'
vStringLength = TM1ValIndex(pPoolHandle, 10)
'
' Next, use this string length to build value capsules for the
' user name, password, and TM1Server name.  We can reuse the pool Handle
' for these functions.
'
vUserName = TM1ValString(pPoolHandle, "admin", vStringLength)
vPassword = TM1ValString(pPoolHandle, "", vStringLength)
vServerName = TM1ValString(pPoolHandle, "gpdev", vStringLength)
vServerHandle = TM1SystemServerConnect(pPoolHandle, vServerName, vUserName, vPassword)

If (TM1ValType(hUser, vServerHandle) = TM1ValTypeObject()) Then
   ' MsgBox "You Logged in Successfully"
End If
If (TM1ValType(hUser, vServerHandle) = TM1ValTypeError()) Then
    MsgBox "The server handle contains an error code."
End If


Dim year As String
Dim month As String
Dim currency1 As String
Dim rate As String



year = "2009"
month = "April"
currency1 = "EUR"
rate = "rate"


Dim hDimYear As Long
Dim vYear As Long
Dim hDimMonth As Long
Dim vMonth As Long
Dim hDimCurrency As Long
Dim vCurrency As Long
Dim hDimRate As Long
Dim vRate As Long


ReDim elementArray(6) As Long


hDimYear = TM1ObjectListHandleByNameGet(pPoolHandle, vServerHandle, TM1ServerDimensions(), TM1ValString(pPoolHandle, "Year", 100))
vYear = TM1ObjectListHandleByNameGet(pPoolHandle, hDimYear, TM1DimensionElements(), TM1ValString(pPoolHandle, year, 100))

hDimMonth = TM1ObjectListHandleByNameGet(pPoolHandle, vServerHandle, TM1ServerDimensions(), TM1ValString(pPoolHandle, "Month", 100))
vMonth = TM1ObjectListHandleByNameGet(pPoolHandle, hDimMonth, TM1DimensionElements(), TM1ValString(pPoolHandle, month, 100))

hDimCurrency = TM1ObjectListHandleByNameGet(pPoolHandle, vServerHandle, TM1ServerDimensions(), TM1ValString(pPoolHandle, "Currency", 100))
vCurrency = TM1ObjectListHandleByNameGet(pPoolHandle, hDimCurrency, TM1DimensionElements(), TM1ValString(pPoolHandle, currency1, 100))

hDimRate = TM1ObjectListHandleByNameGet(pPoolHandle, vServerHandle, TM1ServerDimensions(), TM1ValString(pPoolHandle, "Rate_m", 100))
vRate = TM1ObjectListHandleByNameGet(pPoolHandle, hDimRate, TM1DimensionElements(), TM1ValString(pPoolHandle, rate, 100))


elementArray(1) = vYear
elementArray(2) = vMonth
elementArray(3) = vCurrency
elementArray(4) = vRate

'create cube handle.
hCubeObject = TM1ObjectListHandleByNameGet(pPoolHandle, vServerHandle, TM1ServerCubes(), TM1ValString(pPoolHandle, "ExchangeRate", 100))


Dim vArrayOfCells As Long
vArrayOfCells = TM1ValArray(pPoolHandle, elementArray, 4)
'set the array values
Call TM1ValArraySet(vArrayOfCells, elementArray(1), 1)
Call TM1ValArraySet(vArrayOfCells, elementArray(2), 2)
Call TM1ValArraySet(vArrayOfCells, elementArray(3), 3)
Call TM1ValArraySet(vArrayOfCells, elementArray(4), 4)


Dim value As Long

value = TM1CubeCellValueGet(pPoolHandle, hCubeObject, elementArrayCapsule)

MsgBox TM1ValType(hUser, value)

'
' To log out and disconnect from the API, you must
' call TM1SystemServerDisconnect, TM1SystemClose, then TM1APIFinalize.
'
' In addition, best practice dictates that all TM1 Value Pools used
' in your program be destroyed by calling TM1ValPoolDestroy().
'
vResult = TM1SystemServerDisconnect(pPoolHandle, vServerName)
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Add Code to delete all TM1 Value Pools here.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
TM1ValPoolDestroy (pPoolHandle)
TM1SystemClose hUser
TM1APIFinalize
End Sub

Code: Select all

>Public Sub Test()
>
>MsgBox Application.Run("DBR", "ExchangeRate", "2008", "June", "HKD", "rate")
>
>End Sub
>

Code: Select all

' Returns the current value for the specified cell.
' CubeName should be in the format "Server:CubeName".
' DENVP (Dimension element name/value pairs) E.g. "Dimension1", "Element form Dimension 1", "Dimension2", "Element form Dimension2"
Public Function GV(CubeName As String, ParamArray DENVP())
  Dim i As Integer
  
  Dim hElementArray() As Long
  Dim hCube As Long
  Dim hEACapsule As Long
  
  Dim h As Long
  Dim v As Long

  ReDim hElementArray((UBound(DENVP) + 1) / 2)
  
  For i = 0 To UBound(DENVP) Step 2
    h = TM1ObjectListHandleByNameGet(m_hPool, m_hServer, TM1ServerDimensions(), TM1ValString(m_hPool, DENVP(i), 100))
    v = TM1ObjectListHandleByNameGet(m_hPool, h, TM1DimensionElements(), TM1ValString(m_hPool, DENVP(i + 1), 100))
    
    hElementArray(i / 2 + 1) = v
  Next
  
  hCube = TM1ObjectListHandleByNameGet(m_hPool, m_hServer, TM1ServerCubes(), TM1ValString(m_hPool, CubeName, 100))
  
  hEACapsule = TM1ValArray(m_hPool, hElementArray(), (UBound(DENVP) + 1) / 2)
  For i = 1 To UBound(hElementArray)
     TM1ValArraySet hEACapsule, hElementArray(i), i
  Next
  
  Debug.Print TM1CubeCellValueGet(m_hPool, hCube, hEACapsule)
  
'  Debug.Print TM1ValType(m_hUser, TM1CubeCellValueGet(m_hPool, hCube, hEACapsule))

End Function

Code: Select all

' Returns the current value for the specified cell as a variant.
' Parameters:-
'   CubeName: Name of the cube holding the required value.
'   DENVP:   (Dimension element name/value pairs) E.g. "Dimension1", "Element form Dimension 1", "Dimension2", "Element form Dimension2"
Public Function GetCellValue(CubeName As String, ParamArray DENVP()) As Variant
  Dim i As Integer
  
  Dim hElementArray() As Long
  Dim hCube As Long
  Dim hEACapsule As Long
  Dim hRetVal As Long
  Dim hRetValType As Long
  Dim sErrMsg As String * 100
  Dim ErrCode As Long
  
  Dim h As Long
  Dim v As Long

  ReDim hElementArray((UBound(DENVP) + 1) / 2)
  
  For i = 0 To UBound(DENVP) Step 2
    h = TM1ObjectListHandleByNameGet(m_hPool, m_hServer, TM1ServerDimensions(), TM1ValString(m_hPool, DENVP(i), Len(DENVP(i))))
    v = TM1ObjectListHandleByNameGet(m_hPool, h, TM1DimensionElements(), TM1ValString(m_hPool, DENVP(i + 1), Len(DENVP(i + 1))))
    
    hElementArray(i / 2 + 1) = v
  Next
  
  hCube = TM1ObjectListHandleByNameGet(m_hPool, m_hServer, TM1ServerCubes(), TM1ValString(m_hPool, CubeName, Len(CubeName)))
  
  hEACapsule = TM1ValArray(m_hPool, hElementArray(), (UBound(DENVP) + 1) / 2)
  For i = 1 To UBound(hElementArray)
     TM1ValArraySet hEACapsule, hElementArray(i), i
  Next
  
  hRetVal = TM1CubeCellValueGet(m_hPool, hCube, hEACapsule)
  hRetValType = TM1ValType(m_hUser, hRetVal)
  
  Select Case hRetValType
    Case TM1ValTypeError()
      ErrCode = TM1ValErrorCode(m_hUser, hRetVal)
      TM1ValErrorString_VB m_hUser, hRetVal, sErrMsg, 100
      Err.Raise ErrCode, "GetCellValue", "Cannot get the specified cell Value!" & vbCrLf & sErrMsg
    
    Case TM1ValTypeString
      TM1ValStringGet_VB m_hUser, hRetVal, sErrMsg, 100
      GetCellValue = sErrMsg
      
    Case TM1ValTypeReal
      GetCellValue = TM1ValRealGet(m_hUser, hRetVal)
  End Select

End Function