VBA Process Run Issue Encountered
Posted: Thu Jan 06, 2011 11:02 am
Guys,
I have used soem of the code that I found on the forum to try run a process from Excel. I have been happliy plugging away but I have now come across an erorr that I can't find. I'm getting a type mismatch. Can any of you guys see where my problem is?
I have used soem of the code that I found on the forum to try run a process from Excel. I have been happliy plugging away but I have now come across an erorr that I can't find. I'm getting a type mismatch. Can any of you guys see where my problem is?
Code: Select all
Public Const c_ServerName = "tm1development"
Public Const c_AdminHost = "sjmb089as"
Declare Sub TM1APIInitialize Lib "tm1api.dll" ()
Declare Function TM1SystemOpen Lib "tm1api.dll" () As Long
Declare Function TM1ValPoolCreate Lib "tm1api.dll" (ByVal hUser As Long) As Long
Declare Sub TM1SystemAdminHostSet Lib "tm1api.dll" (ByVal hUser As Long, ByVal AdminHosts As String)
Declare Function TM1SystemServerNof Lib "tm1api.dll" (ByVal hUser As Long) As Integer
Declare Function TM1ValString Lib "tm1api.dll" (ByVal hPool As Long, ByVal InitString As String, ByVal MaxSize As Long) As Long
Declare Function TM1SystemServerConnect Lib "tm1api.dll" (ByVal hPool As Long, ByVal sDatabase As Long, ByVal sClient As Long, ByVal sPassword As Long) As Long
Declare Function TM1ValArray Lib "tm1api.dll" (ByVal hPool As Long, ByRef sArray() As Long, ByVal MaxSize As Long) As Long
Declare Sub TM1ValArraySet Lib "tm1api.dll" (ByVal vArray As Long, ByVal val As Long, ByVal index As Long)
Declare Function TM1ObjectListHandleByNameGet Lib "tm1api.dll" (ByVal nPool As Long, ByVal hObject As Long, ByVal iPropertyList As Long, ByVal sName As Long) As Long
Declare Function TM1ProcessExecute Lib "tm1api.dll" (ByVal hPool As Long, ByVal hProcess As Long, ByVal hParametersArray As Long) As Long
Declare Function TM1ValType Lib "tm1api.dll" (ByVal hUser As Long, ByVal Value As Long) As Integer
Declare Sub TM1ValErrorString_VB Lib "tm1api.dll" (ByVal hUser As Long, ByVal vValue As Long, ByVal Str As String, ByVal Max As Integer)
Declare Function TM1ValBoolGet Lib "tm1api.dll" (ByVal hUser As Long, ByVal vBool As Long) As Integer
Declare Function TM1SystemServerDisconnect Lib "tm1api.dll" (ByVal hPool As Long, ByVal hDatabase As Long) As Long
Declare Sub TM1ValPoolDestroy Lib "tm1api.dll" (ByVal hPool As Long)
Declare Sub TM1SystemClose Lib "tm1api.dll" (ByVal hUser As Long)
Public Function p_ExecuteTM1process(ByVal tm1process As String, ByVal parameters As Variant, ByVal login As String, ByVal password As String) As Boolean
'---------------------------------------------------------------------------------------------
' Author:
' Jim Wood
' 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
Sub Button_proc_load()
Call p_ExecuteTM1process("fwibble_proc", 0, "admin", "pear")
End Sub