This file contains an annotated Essbase Visual Basic API program. This fundamental sample program can be used in a Visual Basic programming environment as a starting point for more functional programs.
This file is to be used with the Hyperion Essbase API Reference to illustrate basic points in API programming. A complete set of actual VB code files is also included with the Hyperion Essbase API.
Note:This sample program uses update, report, and calc scripts. By default, the Essbase server assumes such scripts are located in the application/database directory of the connected database. In the case of this sample program that directory is /Essbase/App/Sample/Basic. The next place the server will look for the script files is the directory in which the program is running. The standard Essbase installation will have the calcdat.txt data load file, but the other script files need to be copied from /Essbase/Docs/Api/Samples/vbexecs/V3Report to /Essbase/App/Sample/Basic. You could put the files in any other location, but then you would have to specify the fully qualified paths to them in your program.
This code is attached to the form itself. It calls functions in Code.bas (which follows). This arrangement allows you to include Code.bas in other projects.
Sub cmdStart_Click() Call Code.ESB_Init ' Initializes ESB_INIT_T and calls EsbInit() Call ESB_Login ' EsbLogin() sets server, user and password Call SetAfterLogin End Sub
Sub cmdStop_Click() Call ESB_Logout ' Should logout all login IDs (context handles) Call ESB_Term ' EsbTerm() terminates the API Call lstMessagesClear Call SetBeforeStart End Sub
Sub cmdClearMsg_Click() lstMessages.Clear 'Clear Messages End Sub
Sub cmdCalcFile_Click() Call ESB_CalcFile 'Calculate End Sub
Sub cmdClrData_Click() Call ESB_SetActive 'Set the active database before calling EsbClearDatabase() Call ESB_ClrData 'Clear data End Sub
Sub cmdLdData_Click() MsgBox "WAIT!! Don't do anything until this process completes. Click OK and wait about 15 seconds. " Call ESB_LdData 'Import Data End Sub
Sub cmdQryFile_Click() Call ESB_QryFile End Sub
Sub cmdQryStr_Click() Call ESB_QryStr End Sub
Sub cmdQryStrs_Click() ' Call QryStrs Call ESB_BeginReport ' 1. EsbBeginReport() Call ESB_SendString ' 2. EsbSendString() - for each string in the report spec Call ESB_EndReport ' 3. EsbEndReport() '*** Display returned data strings; assumes EsbBeginReport()'s ouput flag is TRUE If lngStatus = 0 Then ' If EsbEndReport() succeeded, call EsbGetString() Call ESB_GetString ' Server outputs data if intWhetherOutput = ESB_TRUE; ' ESB_GetString calls EsbGetString() to read the returned ' data until an empty string is returned End If End Sub
Sub cmdUpdFile_Click() Call ESB_UpdFile End Sub
Sub Form_Load() Call SetBeforeStart End Sub
Sub SetBeforeStart() '*** Enable cmdStart cmdStart.Enabled = True '*** Disable everything else cmdStop.Enabled = False cmdClearMsg.Enabled = False lstMessages.Enabled = False cmdCalcFile.Enabled = False cmdClrData.Enabled = False cmdLdData.Enabled = False cmdQryStr.Enabled = False cmdQryStrs.Enabled = False cmdQryFile.Enabled = False cmdUpdFile.Enabled = False End Sub
Sub SetAfterLogin() '*** Disable cmdStart cmdStart.Enabled = False '*** Enable everything else cmdStop.Enabled = True cmdClearMsg.Enabled = True lstMessages.Enabled = True cmdCalcFile.Enabled = True cmdClrData.Enabled = True cmdLdData.Enabled = True cmdQryStr.Enabled = True cmdQryStrs.Enabled = True cmdQryFile.Enabled = True cmdUpdFile.Enabled = True End Sub
This code is in code.bas.
Option Explicit '******************* 'RETURN ERROR STATUS '******************* Dim lngStatus As Long '*********** 'INIT GLOBAL '*********** Dim structInit As ESB_INIT_T Dim lngInstHndl As Long Dim lngCtxHndl As Long '********************* 'ESB_GetMESSAGE GLOBAL '********************* Dim intMsgLev As Integer Dim lngMsgNmbr As Long '****************************************** 'ESB_SetACTIVE and ESB_ClearDATABASE GLOBAL '****************************************** Dim strActiveApp As String Dim strActiveDb As String
'********************************************* 'Init and turn Essbase error handle turned off '********************************************* Sub ESB_Init() ESB_TRUE = 1 ' ESB_TRUE ESB_FALSE = 0 ' and ESB_FALSE are variables, not constants '********************** ' Define init structure '********************** structInit.Version = ESB_API_VERSION structInit.MaxHandles = 10 structInit.LocalPath = "$ARBORPATH" structInit.MessageFile = "" structInit.ClientError = ESB_TRUE structInit.ErrorStack = 100 '****************** 'Initialize the API '****************** lngStatus = EsbInit(structInit, lngInstHndl) '************** 'Error Checking '************** If lngStatus = 0 Then MsgBox "The API is initialized: " & (lngInstHndl) Else MsgBox "The API failed to initialize: " & (lngStatus) End If End Sub
'******************************************************* 'Login in user Admin. All login parameters are hardcoded '******************************************************* Sub ESB_Login() Dim strServer As String * ESB_SVRNAMELEN Dim strUser As String * ESB_USERNAMELEN Dim strPassword As String * ESB_PASSWORDLEN Dim intNumAppDb As Integer strServer = "Localhost" strUser = "Admin" strPassword = "password" lngStatus = EsbLogin(lngInstHndl, _ strServer, strUser, strPassword, _ intNumAppDb, _ lngCtxHndl) '************** 'Error Checking '************** If lngStatus = 0 Then MsgBox "Admin is logged in, with login ID (context handle) " & (lngCtxHndl) _ & Chr$(10) & "WAIT! DO NOTHING!" _ & Chr$(10) & "Retrieving login status; setting Sample/Basic as active" '************************************************* 'Call the SetActive routine to select Sample Basic '************************************************* Call ESB_ListErrorStackMsgs ' Even successful logins return useful messages Call ESB_SetActive Else MsgBox "Login failed: " & (lngStatus) End If End Sub
'************************************************** 'Sets the caller's active application and database. '************************************************** Sub ESB_SetActive() Dim intUserAccess As Integer strActiveApp = "Sample" strActiveDb = "Basic" lngStatus = EsbSetActive(lngCtxHndl, strActiveApp, strActiveDb, intUserAccess) '************** 'Error Checking '************** If lngStatus = 0 Then MsgBox (strActiveApp) & "/" & (strActiveDb) & " is now active" Else MsgBox "EsbSetActive() failed: " & (lngStatus) End If End Sub
'******* ' Logout '******* Sub ESB_Logout() lngStatus = EsbLogout(lngCtxHndl) '********************************************** 'Display whether the logout succeeded or failed '********************************************** If lngStatus = 0 Then MsgBox "Admin, with login ID (context handle) " & (lngCtxHndl) _ & ", is logged out" Else MsgBox "EsbLogout() failed: " & (lngStatus) End If End Sub
'***************************** ' Terminate the Essbase VB API '***************************** Sub ESB_Term() EsbTerm (lngInstHndl) '********************************** 'Display whether the API terminated '********************************** If lngStatus = 0 Then MsgBox "The API is terminated" Else MsgBox "EsbTerm() failed: " & (lngStatus) End If End Sub
'*********************************************** 'Gets a string of data from the active database. '*********************************************** Sub ESB_GetString() Const intDStringLen = 256 Dim strDataString As String * intDStringLen Dim intNumGSCalls As Integer intNumGSCalls = 1 lngStatus = EsbGetString(lngCtxHndl, strDataString, intDStringLen) '*************************************************************** 'Call EsbGetString() until an empty string (no data) is returned '*************************************************************** Do While Mid$(strDataString, 1, 1) <> Chr$(0) If lngStatus = 0 Then MsgBox "EsbGetString() call #" & (intNumGSCalls) & " just read the string" _ & Chr$(10) & (strDataString) ' The server's translation of the query string lstMessages (strDataString) ' Display each returned string on a line intNumGSCalls = intNumGSCalls + 1 ' Increment now often EsbGetString() is called Else MsgBox "EsbGetString() failed: " & (lngStatus) End If lngStatus = EsbGetString(lngCtxHndl, strDataString, intDStringLen) Loop End Sub
'******************************************************************** 'EsbSendString() sends a string of data to the active database. 'This function should be called after EsbBeginReport(),EsbBeginUpdate(), 'or EsbBeginCalc() '********************************************************************** Sub ESB_SendString() Dim strQueryString As String Dim arrQueryStrings(1 To 8) As String Dim intCounter As Integer arrQueryStrings(1) = "<PAGE (Market, Measures) " arrQueryStrings(2) = "<COLUMN (Year, Scenario) " arrQueryStrings(3) = "<ROW (Product) " arrQueryStrings(4) = "<ICHILD Market " arrQueryStrings(5) = "Qtr1 Qtr2 " arrQueryStrings(6) = "Actual Budget Variance " arrQueryStrings(7) = "<ICHILD Product " arrQueryStrings(8) = "!" '***************************************************** 'Send a series of query strings to the active database '***************************************************** For intCounter = 1 To 8 strQueryString = arrQueryStrings(intCounter) lngStatus = EsbSendString(lngCtxHndl, strQueryString) '************** 'Error Checking '************** If lngStatus = 0 Then MsgBox "EsbSendString() sent query string # " & (intCounter) _ & " to the active database" lstMessages (strQueryString) Else MsgBox "EsbSendString() failed: " & (lngStatus) Exit Sub End If Next End Sub
'**************************************************************** 'Sends a report specification to the active database from a file '**************************************************************** Sub ESB_QryFile() Dim lngDbCtxHndl As Long Dim lngRFCtxHndl As Long Dim strAppName As String Dim strDbName As String Dim strReportFile As String Dim intWhetherOutput As Integer Dim intWhetherLock As Integer lngDbCtxHndl = lngCtxHndl lngRFCtxHndl = lngCtxHndl strAppName = "Sample" strDbName = "Basic" strReportFile = "MyRpt01" intWhetherOutput = ESB_TRUE ' If TRUE, data is output from server intWhetherLock = ESB_FALSE ' If TRUE, blocks are locked for update ' If both are FALSE, report spec checked for syntax lngStatus = EsbReportFile(lngDbCtxHndl, lngRFCtxHndl, strAppName, strDbName, _ strReportFile, intWhetherOutput, intWhetherLock) '************** 'Error Checking '************** If lngStatus = 0 Then MsgBox "The report file" & Chr$(10) & (strReportFile) & Chr$(10) _ & "was sent to " & (strAppName) & (strDbName) & Chr$(10) _ & "EsbGetString() will read the data" '****************************************************************************** 'Calls EsbGetString to read the returned data until an empty string is returned '****************************************************************************** Call ESB_GetString Else MsgBox "EsbReportFile() failed: " & (lngStatus) End If End Sub
'********************************************************************** 'Sends a report specification to the active database as a single string '********************************************************************** Sub ESB_QryStr() Dim intWhetherOutput As Integer Dim intWhetherLock As Integer Dim strQueryString As String strQueryString = "<DESC Year !" ' One query string intWhetherOutput = ESB_TRUE ' If TRUE, data is output from server intWhetherLock = ESB_FALSE ' If TRUE, blocks are locked for update ' If both are FALSE, report spec checked for syntax lngStatus = EsbReport(lngCtxHndl, intWhetherOutput, intWhetherLock, strQueryString) '************** 'Error Checking '************** If lngStatus = 0 Then MsgBox "The report specification" & Chr$(10) & (strQueryString) & Chr$(10) _ & "was sent to the active database" & Chr$(10) _ & "EsbGetString() will read the data" '********************************************************* ' Server outputs data if intWhetherOutput = ESB_TRUE; ' ESB_GetString calls EsbGetString() to read the returned ' data until an empty string is returned '********************************************************* Call ESB_GetString Else MsgBox "EsbReport() failed: " & (lngStatus) End If End Sub
'**************************************************************** 'Sends an update specification to the active database from a file '**************************************************************** Sub ESB_UpdFile() Dim lngDbCtxHndl As Long Dim lngUFCtxHndl As Long Dim strAppName As String Dim strDbName As String Dim strUpdateFile As String Dim intWhetherStore As Integer Dim intWhetherUnlock As Integer lngDbCtxHndl = lngCtxHndl lngUFCtxHndl = lngCtxHndl strAppName = "Sample" strDbName = "Basic" strUpdateFile = "CDupdtDb" intWhetherStore = ESB_TRUE ' Database is updated & data is stored (on server) intWhetherUnlock = ESB_TRUE ' Locked blocks are unlocked after data is updated '******************************************* 'Lock database blocks before you update them '******************************************* Call ESB_LockDatabase '****************************************** 'Send update file to the specified database '****************************************** lngStatus = EsbUpdateFile(lngDbCtxHndl, lngUFCtxHndl, strAppName, strDbName, _ strUpdateFile, intWhetherStore, intWhetherUnlock) '************** 'Error Checking '************** If lngStatus = 0 Then MsgBox "The update file" & Chr$(10) & (strUpdateFile) & Chr$(10) _ & "was sent to " & (strAppName) & (strDbName) Else MsgBox "EsbUpdateFile() failed: " & (lngStatus) End If '******************************** 'Calls error checking sub routine '******************************** Call ESB_ListErrorStackMsgs End Sub
'************************************************************ 'Starts sending a report specification to the active database '************************************************************ Sub ESB_BeginReport() Dim intWhetherOutput As Integer Dim intWhetherLock As Integer Dim strQueryString As String intWhetherOutput = ESB_TRUE ' If TRUE, data is output from server intWhetherLock = ESB_FALSE ' If TRUE, blocks are locked for update ' If both are FALSE, report spec checked for syntax lngStatus = EsbBeginReport(lngCtxHndl, intWhetherOutput, intWhetherLock) '************** 'Error Checking '************** If lngStatus = 0 Then MsgBox "EsbBeginReport() succeeded" Else MsgBox "EsbBeginReport() failed: " & (lngStatus) End If End Sub
'*********************************************************************** 'EsbEndReport marks the end of the report specification sent to the 'active database. '*********************************************************************** Sub ESB_EndReport() lngStatus = EsbEndReport(lngCtxHndl) '************** 'Error Checking '************** If lngStatus = 0 Then MsgBox "EsbEndReport() succeeded" Else MsgBox "EsbEndReport() failed: " & (lngStatus) '******************************** 'Calls error checking sub routine '******************************** Call ESB_ListErrorStackMsgs Exit Sub End If End Sub
'************************************************************** 'Executes a calc script against the active database from a file '************************************************************** Sub ESB_CalcFile() Dim lngDbCtxHndl As Long Dim lngCSCtxHndl As Long Dim strAppName As String Dim strDbName As String Dim strCalcScriptFile As String Dim intWhetherCalc As Integer ' If TRUE, the calc script is executed lngDbCtxHndl = lngCtxHndl lngCSCtxHndl = lngCtxHndl strAppName = "Sample" strDbName = "Basic" strCalcScriptFile = "Calc5Dim" intWhetherCalc = ESB_TRUE lngStatus = EsbCalcFile(lngDbCtxHndl, lngCSCtxHndl, strAppName, strDbName, _ strCalcScriptFile, intWhetherCalc) '************** 'Error Checking '************** If lngStatus = 0 Then MsgBox (strAppName) & (strDbName) & " is being calculated" & Chr$(10) _ & "using the calc script in " & (strCalcScriptFile) '********************************************************* 'Call Esb_GetProcessState to get the current state of calc '********************************************************* Call ESB_GetProcessState Else MsgBox "EsbCalcFile() failed: " & (lngStatus) '******************************** 'Calls error checking sub routine '******************************** Call ESB_ListErrorStackMsgs End If End Sub
'*********************************** 'Clear data from the active database '*********************************** Sub ESB_ClrData() lngStatus = EsbClearDatabase(lngCtxHndl) '******************** 'Begin error checking '******************** If lngStatus = 0 Then MsgBox "WAIT!! Data is being cleared from " & (strActiveApp) & (strActiveDb) '************************************************************ 'Call Esb_GetProcessState to get the current state of process '************************************************************ Call ESB_GetProcessState Else MsgBox "EsbClearDatabase() failed: " & (lngStatus) '******************************** 'Calls error checking sub routine '******************************** Call ESB_ListErrorStackMsgs End If End Sub
'************************************************* 'Import data from different sources to the Essbase '************************************************* Sub ESB_LdData() Dim structRulesFile As ESB_OBJDEF_T Dim structDataFile As ESB_OBJDEF_T Dim structSQLSource As ESB_MBRUSER_T Dim strErrorsOnLoadFile As String Dim intWhetherAbortOnError As Integer structDataFile.hCtx = lngCtxHndl structDataFile.Type = ESB_OBJTYPE_TEXT structDataFile.AppName = "Sample" structDataFile.DbName = "Basic" structDataFile.FileName = "CalcDat" strErrorsOnLoadFile = "ErrsOnLd.txt" intWhetherAbortOnError = ESB_TRUE '******************************************** 'Import data from CalcDat.txt to Sample/Basic '******************************************** lngStatus = EsbImport(lngCtxHndl, structRulesFile, structDataFile, structSQLSource, _ strErrorsOnLoadFile, intWhetherAbortOnError) '************** 'Error Checking '************** If lngStatus = 0 Then MsgBox "WAIT!! Data from " & (structDataFile.FileName) & Chr$(10) _ & "is being imported to " & (structDataFile.AppName) & (structDataFile.DbName) '*********************************************************** 'Call Esb_GetProcessState to get the current state of import '*********************************************************** Call ESB_GetProcessState Else MsgBox "EsbImport() failed: " & (lngStatus) '******************************** 'Calls error checking sub routine '******************************** Call ESB_ListErrorStackMsgs End If End Sub
'******************************************************************* ' ESB_LockDatabase() calls EsbReportFile() to lock blocks for update '******************************************************************* Sub ESB_LockDatabase() Dim lngDbCtxHndl As Long Dim lngRFCtxHndl As Long Dim strAppName As String Dim strDbName As String Dim strReportFile As String Dim intWhetherOutput As Integer ' If TRUE, data is output from server Dim intWhetherLock As Integer ' If TRUE, blocks are locked for update lngDbCtxHndl = lngCtxHndl lngRFCtxHndl = lngCtxHndl strAppName = "Sample" strDbName = "Basic" strReportFile = "CDlockDb" intWhetherOutput = ESB_FALSE ' FALSE: no data is output from server intWhetherLock = ESB_TRUE ' TRUE: blocks are locked for update lngStatus = EsbReportFile(lngDbCtxHndl, lngRFCtxHndl, strAppName, strDbName, _ strReportFile, intWhetherOutput, intWhetherLock) '************** 'Error Checking '************** If lngStatus = 0 Then MsgBox "The report file" & Chr$(10) & (strReportFile) & Chr$(10) _ & "was sent to " & (strAppName) & (strDbName) & Chr$(10) _ & "Blocks are locked for update" & Chr$(10) _ & "EsbUpdateFile() will update the CalcData database" Else MsgBox "EsbReportFile() failed: " & (lngStatus) '******************************** 'Calls error checking sub routine '******************************** Call ESB_ListErrorStackMsgs End If End Sub
'****************************************************************** 'Get the current state of an asynchronous process until it finishes '****************************************************************** Sub ESB_GetProcessState() Dim structProcessState As ESB_PROCSTATE_T lngStatus = EsbGetProcessState(lngCtxHndl, structProcessState) Do Until structProcessState.State = ESB_STATE_DONE lngStatus = EsbGetProcessState(lngCtxHndl, structProcessState) Loop MsgBox "Asynchronous Process Completed" End Sub
'************************************************************ 'This is an error checking subroutine that uses EsbGetMessage '************************************************************ Sub ESB_ListErrorStackMsgs() Const intMsgLen = 256 Dim strMsg As String * intMsgLen lngStatus = EsbGetMessage(lngInstHndl, intMsgLev, lngMsgNmbr, _ strMsg, intMsgLen) Dim intStackNmbr As Integer intStackNmbr = 1 '********************************************************************* 'Do while the error stack has messages and drops messages in a ListBox '********************************************************************* Do While Mid$(strMsg, 1, 1) <> Chr$(0) lstMessages "MESSAGE ON ERROR STACK:" lstMessages "Stack #" & (intStackNmbr) lstMessages "Level #" & (intMsgLev) lstMessages "Message #" & (lngMsgNmbr) lstMessages (strMsg) intStackNmbr = intStackNmbr + 1 lngStatus = EsbGetMessage(lngInstHndl, intMsgLev, lngMsgNmbr, strMsg, intMsgLen) Loop End Sub
Sub lstMessages(strItem As String) frmRprts.lstMessages.AddItem (strItem) End Sub
Sub lstMessagesClear() frmRprts.lstMessages.Clear End Sub