TM1 Forum

Code: Select all

Public Const c_ServerName = "INSTANCENAME"
Public Const c_AdminHost = "SERVERNAME"      

Code: Select all

Public Function p_ExecuteTM1process(ByVal tm1process As String, ByVal parameters As Variant, ByVal login As String, ByVal password As String) As Boolean
'---------------------------------------------------------------------------------------------
' Auteur:
'           Jan
' Parameters:
'           tm1process  -> Name of TM1 process
'           parameters  -> Array containing the parameters for the TM1process
'           login       -> TM1 loginname
'           password    -> TM1 password
' Function:
'           Executes TM1 process 'tm1process'
'           REMARK:
'               Expects the following constants to be declared and initialized:
'                   Const c_ServerName   'Name TM1 server
'                   Const c_AdminHost    'Hostname of TM1 server
' Return:
'           TRUE     -> Function succeeded
'           FALSE    -> Function failed
'---------------------------------------------------------------------------------------------
On Error GoTo AfterError:
    Dim nServerName As Long
    Dim hServerName As Long
    Dim nClientID As Long
    Dim nPassword As Long
    Dim Retlong As Long
    Dim voprocess As Long
    Dim hParametersArray As Long
    Dim iparamarray() As Long
    Dim nNrOfParams As Long
    Dim sprocessname As String
    Dim RetType As Long
    Dim ErrorCode As Long
    Dim nI As Integer
    Dim sErrMsg As String * 100
    
    'Connection
    TM1APIInitialize
    hUser = TM1SystemOpen()
    If hUser = 0 Then
        MsgBox ("Error opening the system")
        GoTo ExitFunction
    End If
    
    'Create pool
    pGeneral = TM1ValPoolCreate(hUser)
    If pGeneral = 0 Then
        MsgBox ("Error creating memory pool")
        GoTo ExitFunction
    End If
    
    'Admin host
    Call TM1SystemAdminHostSet(hUser, c_AdminHost)
    Retlong = TM1SystemServerNof(hUser)
    
    ' Locate server and connect
    nServerName = TM1ValString(pGeneral, c_ServerName, 75)
    nClientID = TM1ValString(pGeneral, login, 75)
    nPassword = TM1ValString(pGeneral, password, 75)
    Call TM1SystemAdminHostSet(hUser, c_AdminHost)
    hServerName = TM1SystemServerConnect(pGeneral, nServerName, nClientID, nPassword)
    
    sprocessname = tm1process
    
    nNrOfParams = UBound(parameters) + 1
    ReDim iparamarray(nNrOfParams - 1)
    
    'For each parameter
    For nI = 1 To nNrOfParams
        iparamarray(nI - 1) = TM1ValString(pGeneral, parameters(nI - 1), Len(parameters(nI - 1)))
    Next nI
    
    hParametersArray = TM1ValArray(pGeneral, iparamarray, nNrOfParams)
    
    'For each parameter
    For nI = 1 To nNrOfParams
        TM1ValArraySet hParametersArray, iparamarray(nI - 1), nI
    Next nI
    
    voprocess = TM1ObjectListHandleByNameGet(pGeneral, hServerName, TM1ServerProcesses(), TM1ValString(pGeneral, sprocessname, 100))
    
    Retlong = TM1ProcessExecute(pGeneral, voprocess, hParametersArray)
    RetType = TM1ValType(hUser, Retlong)
    
    If RetType = TM1ValTypeError Then 'TM1ValTypeObject Then
    'Return value is an error object
        TM1ValErrorString_VB hUser, Retlong, sErrMsg, 100
        Err.Raise vbObjectError + 514, , sErrMsg
    Else
    'Return value is a boolean value
        Retlong = TM1ValBoolGet(hUser, Retlong)
        If Retlong = 0 Then
            Err.Raise vbObjectError + 515, , "Process generated errors" & vbCrLf & "Check log file."
        Else
            'Process executed successfully
        End If
    End If

    p_ExecuteTM1process = True
ExitFunction:
    'DECONNECTION
    If pGeneral > 0 And hServerName > 0 Then
        Retlong = TM1SystemServerDisconnect(pGeneral, hServerName)
    End If
    
    'Destruction of pool
    If pGeneral > 0 Then
        TM1ValPoolDestroy (pGeneral)
    End If
    
    If hUser > 0 Then
        Call TM1SystemClose(hUser)
    End If
    Exit Function

AfterError:
    MsgBox "p_ExecuteTM1process: There was an error while executing process '" & tm1process & "':" & vbCr & vbCr & Err.Description, vbCritical, "Oops"
    Resume ExitFunction
End Function