Drill-through Visual Basic API Example

Attribute VB_Name = "Module3"
Dim sts As Long
   Dim hInst As Long
   Dim hDestInst As Long
   Dim hCtx As Long
   Dim hDestCtx As Long
   Dim Server As String * ESB_SVRNAMELEN
   Dim User As String * ESB_USERNAMELEN
   Dim Password As String * ESB_PASSWORDLEN
   Dim AppName As String * ESB_APPNAMELEN
   Dim DbName As String * ESB_DBNAMELEN

Sub ESB_GetVersion()
   Dim sts As Long
   Dim Release As Integer
   Dim Version As Integer
   Dim Revision As Integer
   sts = EsbGetVersion(hCtx, Release, Version, Revision)
   Debug.Print "EsbGetVersion: sts = " & sts
   Debug.Print "Release: " & Release
   Debug.Print "Version: " & Version
   Debug.Print "Revision: " & Revision
End Sub

Sub ESB_Init()
   Dim Init As ESB_INIT_T

   ESB_FALSE = 0
   ESB_TRUE = 1

   Init.Version = ESB_API_VERSION
   Init.MaxHandles = 10
   Init.LocalPath = "C:\install\zolahit\products\Essbase\EssbaseClient"
   ' Use default message file
   Init.MessageFile = ""
   ' Use EsbGetMessage to retrieve
   ' messages
   Init.ClientError = ESB_TRUE
   Init.ErrorStack = 100
   'Init.vbCallbackFuncAddress = GetProcAddress(AddressOf EsbErrorHandler)

   sts = EsbInit(Init, hInst)
   'MsgBox ("EsbInit = " & sts)
   Debug.Print "EsbInit: sts = " & sts

   'For copy objects between servers
   'sts = EsbInit(Init, hDestInst)
   'MsgBox ("EsbInit = " & sts)
   'Debug.Print "EsbInit: sts = " & sts
End Sub

Public Function GetProcAddress(ByVal lngAddressOf As Long) As Long
   GetProcAddress = lngAddressOf
End Function

Public Function EsbErrorHandler(ByVal MsgNum As Long, ByVal Level As Long, ByVal uLog As String, ByVal uMsg As String) As Long
   If Level >= ESB_LEVEL_ERROR Then
      MsgBox "Error: " & MsgNum & " - " & uMsg
   End If

   'MsgBox " Info " & MsgNum & ": Level: " & Level & ": " & uLog & ": " & uMsg
End Function

Sub ESB_GetMessage()
   Dim DbName As String
   Dim FilterName As String
   Const szMessage = 256
   Dim Message As String * szMessage
   Dim Number As Long
   Dim Level As Integer
   Dim sts As Long
   Dim Object As ESB_OBJDEF_T
   Dim hOutline As Long
   Dim hMemberProfit As Long

   Object.hCtx = hCtx
   Object.Type = ESB_OBJTYPE_OUTLINE
   Object.AppName = "Temp"
   Object.DbName = "Basic"
   Object.FileName = "Basic"
   sts = EsbOtlOpenOutline(hCtx, Object, ESB_YES, ESB_YES, hOutline)
   Debug.Print "EsbOtlOpenOutline: sts = " & sts

   sts = EsbOtlFindMember(hOutline, "100-10", hMember)
   Debug.Print "EsbOtlFindMember: sts = " & sts

   If sts > 0 Then
      sts = EsbGetMessage(hInst, Level, Number, Message, szMessage)
      Do While Mid$(Message, 1, 1) <> Chr$(0)
         Debug.Print Level
         Debug.Print Number
         Debug.Print Message
         sts = EsbGetMessage(hInst, Level, Number, Message, szMessage)
         Debug.Print "EsbGetMessage: sts = " & sts
        Loop
   End If
End Sub

Sub ESB_Login()
   Dim Items As Integer
   Dim AppDb As ESB_APPDB_T

   Server = "ppamu-pc1"
   User = "essexer"
   Password = "password"
   sts = EsbLogin(hInst, Server, User, Password, Items, hCtx)
   Debug.Print "EsbLogin: sts = " & sts
   'For n = 1 To Items
    ' sts = EsbGetNextItem(hCtx, ESB_LAPPDB_TYPE, AppDb)
    ' Debug.Print "EsbGetNextItem: sts = " & sts
    ' Debug.Print "App Name: "; AppDb.AppName
    ' Debug.Print "Db Name: "; AppDb.DbName
  ' Next

   'For copy objects between servers
   'sts = EsbLogin(hDestInst, "qtfsun1:1501", User, Password, Items, hDestCtx)
   'Debug.Print "EsbLogin: sts = " & sts
End Sub

Sub ESB_AutoLogin()
   Dim pOption As Integer
   Dim pAccess As Integer

   Server = "localhost"
   'User = "essexer"
   'Password = "Password"
   'AppName = "sample"
   'DbName = "basic"

   'pOption = ESB_AUTO_NODIALOG + ESB_AUTO_NOSELECT
   pOption = ESB_AUTO_DEFAULT
   sts = EsbAutoLogin(hInst, Server, User, Password, AppName, DbName, pOption, pAccess, hCtx)
   'MsgBox ("EsbAutoLogin = " & sts)
   Debug.Print "EsbAutoLogin: sts = " & sts
  ' Call Esb_runreport
End Sub

Sub ESB_LoginSetPassword()
   'Dim hInst       As Long
   'Dim Server      As String * ESB_SVRNAMELEN
   'Dim User        As String * ESB_USERNAMELEN
   'Dim Password    As String * ESB_PASSWORDLEN
   Dim NewPassword  As String * ESB_PASSWORDLEN
   Dim Items        As Integer
   Dim AppDb        As ESB_APPDB_T

   Server = "stiahp1:1501"
   User = "essexer"
   Password = "password"
   NewPassword = "password2"
   sts = EsbLoginSetPassword(hInst, Server, User, Password, NewPassword, Items, hCtx)
   Debug.Print "EsbLoginSetPassword: sts = " & sts

   For N = 1 To Items
      sts = EsbGetNextItem(hCtx, ESB_LAPPDB_TYPE, AppDb)
      Debug.Print "EsbGetNextItem: sts = " & sts
      Debug.Print "App Name: "; AppDb.AppName
      Debug.Print "Db Name: "; AppDb.DbName
   Next

   'Reset password back to original
   NewPassword = "password"
   sts = EsbLoginSetPassword(hInst, Server, User, Password, NewPassword, Items, hCtx)
   Debug.Print "EsbLoginSetPassword: sts = " & sts
End Sub

Sub ESB_SetActive()
   Dim AppName As String
   Dim DbName As String
   Dim pAccess As Integer
   Dim sts As Long

   'AppName = "Bugs"
   'DbName = "09129823"

   AppName = "vb"
   DbName = "Basic"

   sts = EsbSetActive(hCtx, AppName, DbName, pAccess)
   Debug.Print "EsbSetActive: sts = " & sts
End Sub

Sub ESb_GetStoresInfo() '(Chnl As String)
   Dim Object As ESB_OBJDEF_T

   Object.hCtx = hCtx
   Object.Type = ESB_OBJTYPE_OUTLINE
   Object.AppName = AppName
   Object.DbName = DbName
   Object.FileName = DbName
   Dim hMember As Long
   Dim ihMember As Long
   Dim MbrInfo As ESB_MBRINFO_T
   Dim Counts As ESB_MBRCOUNTS_T

   sts = EsbSetActive(hCtx, AppName, DbName, Access)

   Dim hMemberJan As Long
   Dim MbrChldCnt As Long
   Dim x As Integer
   Dim Parent As String
   Dim found As Boolean
   Dim img As Integer
   Dim Member As String
   Dim szAlias As String * ESB_MBRNAMELEN
   Dim Alias As String
   Dim levelnum As String
   Dim ShareStat As Integer

   Dim tLevelName As String * ESB_MBRNAMELEN
   Const AltGroup As String = "ALT_GROUP"
   'Dim LevelName As String * ESB_MBRNAMELEN
   sts = EsbOtlOpenOutline(hCtx, Object, ESB_YES, ESB_YES, hOutline)

   If sts = 0 Then
      sts = EsbOtlFindMember(hOutline, "JOHNSON, ROGER", hMemberJan)
      'sts = EsbOtlFindMember(hOutline, "GMM_A", hMemberJan)
      If hMemberJan = 0 Then
         sts = EsbOtlFindAlias(hOutline, "JOHNSON, ROGER", "default", hMemberJan)
      End If
   End If

   If sts = 0 And hMemberJan <> 0 Then
      sts = EsbOtlGetMemberInfo(hOutline, hMemberJan, MbrInfo)
      MsgBox ("Member Name = " & MbrInfo.szMember)
      Member = MbrInfo.szMember
      levelnum = MbrInfo.usLevel
      ShareStat = MbrInfo.usShare
      MsgBox ("Shared Member = " & ShareStat)
   End If

   MbrChldCnt = MbrInfo.ulChildCount
   ' If ShareStat <> ESB_SHARE_SHARE Then

   'Do While x <= MbrChldCnt
   For x = 1 To MbrChldCnt
      If x = 1 Then
         sts = EsbOtlGetChild(hOutline, hMemberJan, hMember)
         'sts = EsbOtlGetMemberInfo(hOutline, hMember, MbrInfo)
         'MsgBox ("Child Member Name = " & MbrInfo.szMember)
      Else
         sts = EsbOtlGetNextSibling(hOutline, hMemberJan, hMember)
         ' sts = EsbOtlGetMemberInfo(hOutline, hMember, MbrInfo)
         ' MsgBox ("Sibling Member Name = " & MbrInfo.szMember)
      End If

   'Next

      sts = EsbOtlGetMemberInfo(hOutline, hMember, MbrInfo)
         MsgBox ("Sibling Member Name = " & MbrInfo.szMember)
         ' szAlias = ""
         'sts = EsbOtlGetMemberAlias(hOutline, hMember, "", szAlias)
         'sts = EsbOtlGetLevelName(hOutline, sRoot, MbrInfo.usLevel, tLevelName)
         'If sts > 0 Then tLevelName = ""

      'Alias = sTrim(szAlias)
      'Member = sTrim(MbrInfo.szMember)

   Next
End Sub

Sub ESB_Logout()

   sts = EsbLogout(hCtx)
   'MsgBox ("EsbLogout = " & sts)
   Debug.Print "EsbLogout: sts = " & sts
End Sub

Sub ESB_Term()

   sts = EsbTerm(hInst)
   'MsgBox ("EsbTerm = " & sts)
   Debug.Print "EsbTerm: sts = " & sts
End Sub

Public Sub ESB_LROListObjects()
   Dim UserName As String * ESB_USERNAMELEN
   Dim listDate As Long
   Dim Items As Integer
   Dim Desc As ESB_LRODESC_API_T
   Dim i As Integer
   Dim j As Integer
   Dim CutOffDate As Date
   Dim MemberName As String * ESB_MBRNAMELEN

   Const ESB_REFERENCE_DATE = #1/1/1970#
   UserName = "essexer"
   CutOffDate = #9/21/2007#
   'CutOffDate = #1/2/1970#
   listDate = DateDiff("s", CutOffDate, ESB_REFERENCE_DATE)
   'listDate = DateDiff("s", ESB_REFERENCE_DATE, CutOffDate)
   'listDate = -1

   sts = EsbLROListObjects(hCtx, UserName, listDate, Items)
   Debug.Print "EsbLROListObjects: sts = " & sts

   Debug.Print "Number of LRO(s): " & Items

   If sts = 0 Then
      For i = 1 To Items

         Debug.Print "LRO # " & i; ":"

         sts = EsbGetNextItem(hCtx, ESB_LRO_TYPE, Desc)
         Debug.Print "EsbGetNextItem: sts = " & sts
         Debug.Print "Object Type: " & Desc.ObjType
         Select Case (Desc.ObjType)
            Case 0
                Debug.Print "Cell notes: " & Desc.note
            Case 1
                Debug.Print "Object Name: " & Desc.lroInfo.ObjName
                Debug.Print "Object Description: " & Desc.lroInfo.objDesc
            Case 2
                Debug.Print "Object Name: " & Desc.lroInfo.ObjName
                Debug.Print "Object Description: " & Desc.lroInfo.objDesc
         End Select
         Debug.Print "Member Combination:"
         For j = 1 To Desc.memCount
            sts = EsbLROGetMemberCombo(hCtx, j, MemberName)
            Debug.Print "   " & MemberName
         Next j

      Next i
   End If
End Sub

Sub ESB_SetUser()
   Dim sts As Long
   Dim UserInfo As ESB_USERINFO_T
   
   UserInfo.Name = "Test"
   UserInfo.Type = ESB_TYPE_USER
   UserInfo.Access = ESB_ACCESS_SUPER
   UserInfo.MaxAccess = ESB_ACCESS_SUPER
   UserInfo.PwdChgNow = ESB_TRUE
   
   sts = EsbSetUser(hCtx, UserInfo)
   Debug.Print "EsbSetUser: sts = " & sts
End Sub

Sub ESB_GetUser()
   Dim sts As Long
   Dim User As String
   Dim UserInfo As ESB_USERINFO_T
   
   User = "Test"
   '************************
   ' Get User Info structure
   '************************
   sts = EsbGetUser(hCtx, User, UserInfo)
   Debug.Print "EsbGetUser: sts = " & sts
End Sub

Public Sub ESB_LROPurgeObjects()
   Dim UserName As String * ESB_USERNAMELEN
   Dim purgeDate As Long
   Dim Items As Integer
   Dim Desc As ESB_LRODESC_API_T
   Dim CutOffDate As Date
   Dim i As Integer
   Const ESB_REFERENCE_DATE = #1/1/1970#
   
   UserName = "essexer"
   CutOffDate = #9/21/2007#
   purgeDate = DateDiff("s", ESB_REFERENCE_DATE, CutOffDate) 'bug 8-651484045
   'purgeDate = DateDiff("s", CutOffDate, ESB_REFERENCE_DATE)
   'purgeDate = -1
   
   sts = EsbLROPurgeObjects(hCtx, UserName, purgeDate, Items)
   Debug.Print "EsbLROPurgeObjects: sts = " & sts
   
   If sts = 0 Then
      For i = 1 To Items
         '*******************************
         '* Get the next LRO description
         '* item from the list
         '*******************************
         sts = EsbGetNextItem(hCtx, ESB_LRO_TYPE, Desc)
         Debug.Print "EsbGetNextItem: sts = " & sts
      Next i
   End If
End Sub

Sub ESB_CreateGroup()
   Dim sts As Long
   Dim GroupName As String

   GroupName = "PowerUsers"
  sts = EsbCreateGroup(hCtx, GroupName)
   Debug.Print "EsbCreateGroup: sts = " & sts
End Sub

Sub ESB_GetDatabaseInfo()
   Dim sts As Long
   Dim AppName As String
   Dim DbName As String
   Dim Items As Integer
   Dim N As Integer
   Dim DbInfo As ESB_DBINFO_T
   Dim DbReqInfo As ESB_DBREQINFO_T

   AppName = "Sample"
   DbName = "Basic"
  sts = EsbGetDatabaseInfo(hCtx, AppName, DbName, DbInfo, Items)
   Debug.Print "EsbGetDatabaseInfo: sts = " & sts
   Debug.Print "DbInfo.status: " & DbInfo.Status

   If sts = 0 Then
      For N = 1 To Items
        sts = EsbGetNextItem(hCtx, ESB_DBREQINFO_TYPE, DbReqInfo)
         Debug.Print "EsbGetNextItem: sts = " & sts
      Next
   End If
End Sub

Sub ESB_GetDatabaseAccess()
   Dim Items As Integer
   Dim AppName As String
   Dim DbName As String
   Dim User As String
   Dim UserDb As ESB_USERDB_T
   Dim sts As Long
   
   AppName = "Sample"
   DbName = "Basic"
   
   User = "user1"
  sts = EsbGetDatabaseAccess(hCtx, User, AppName, DbName, Items)
   Debug.Print "EsbGetDatabaseAccess: sts = " & sts
   For N = 1 To Items
    sts = EsbGetNextItem(hCtx, ESB_USERDB_TYPE, UserDb)
     Debug.Print "EsbGetNextItem: sts = " & sts
     Debug.Print "User: " & User
     Debug.Print "Access: " & UserDb.Access
   Next
   
   User = "user2"
  sts = EsbGetDatabaseAccess(hCtx, User, AppName, DbName, Items)
   Debug.Print "EsbGetDatabaseAccess: sts = " & sts
   For N = 1 To Items
    sts = EsbGetNextItem(hCtx, ESB_USERDB_TYPE, UserDb)
     Debug.Print "EsbGetNextItem: sts = " & sts
     Debug.Print "User: " & User
     Debug.Print "Access: " & UserDb.Access
   Next
   
   User = "user3"
  sts = EsbGetDatabaseAccess(hCtx, User, AppName, DbName, Items)
   Debug.Print "EsbGetDatabaseAccess: sts = " & sts
   For N = 1 To Items
    sts = EsbGetNextItem(hCtx, ESB_USERDB_TYPE, UserDb)
     Debug.Print "EsbGetNextItem: sts = " & sts
     Debug.Print "User: " & User
     Debug.Print "Access: " & UserDb.Access
   Next
   
   User = "user4"
  sts = EsbGetDatabaseAccess(hCtx, User, AppName, DbName, Items)
   Debug.Print "EsbGetDatabaseAccess: sts = " & sts
   For N = 1 To Items
    sts = EsbGetNextItem(hCtx, ESB_USERDB_TYPE, UserDb)
     Debug.Print "EsbGetNextItem: sts = " & sts
     Debug.Print "User: " & User
     Debug.Print "Access: " & UserDb.Access
   Next
   
   User = "user5"
  sts = EsbGetDatabaseAccess(hCtx, User, AppName, DbName, Items)
   Debug.Print "EsbGetDatabaseAccess: sts = " & sts
   For N = 1 To Items
    sts = EsbGetNextItem(hCtx, ESB_USERDB_TYPE, UserDb)
     Debug.Print "EsbGetNextItem: sts = " & sts
     Debug.Print "User: " & User
     Debug.Print "Access: " & UserDb.Access
   Next
   
   User = "user6"
  sts = EsbGetDatabaseAccess(hCtx, User, AppName, DbName, Items)
   Debug.Print "EsbGetDatabaseAccess: sts = " & sts
   For N = 1 To Items
    sts = EsbGetNextItem(hCtx, ESB_USERDB_TYPE, UserDb)
     Debug.Print "EsbGetNextItem: sts = " & sts
     Debug.Print "User: " & User
     Debug.Print "Access: " & UserDb.Access
   Next
End Sub

Sub ESB_GetDatabaseStats()
   Dim Items As Integer
   Dim AppName As String
   Dim DbName As String
   Dim DbStats As ESB_DBSTATS_T
   Dim DimStats As ESB_DIMSTATS_T
   Dim sts As Long
   AppName = "Sample"
   DbName = "Basic"
   sts = EsbGetDatabaseStats(hCtx, AppName, DbName, DbStats, Items)
   Debug.Print "EsbGetDatabaseStats: sts = " & sts
   'MsgBox ("cluster = " & DbStats.ClusterRatio)
   For N = 1 To Items
      sts = EsbGetNextItem(hCtx, ESB_DBSTATS_TYPE, DbStats)
   Next
End Sub

Public Sub ESB_LROAddObject()
   Dim Desc As ESB_LRODESC_API_T
   Dim memCount As Long
   Dim memComb As String
   Dim opt As Integer
   Dim i As Integer

   memCount = 5
   memComb = "Year" & vbCrLf & "Product" & vbCrLf & _
      "Market" & vbCrLf & "Measures" & vbCrLf & "Scenario"
   Desc.UserName = "essexer"

   Desc.ObjType = ESB_LROTYPE_CELLNOTE_API
   Desc.note = "Cell note"
   opt = ESB_NOSTORE_OBJECT_API
   sts = EsbLROAddObject(hCtx, memCount, memComb, opt, Desc)
   Debug.Print "EsbLROAddObject: sts = " & sts

   Desc.ObjType = ESB_LROTYPE_WINAPP_API
   Desc.lroInfo.ObjName = "c:\hyperion\essbase95\bin\essbase.exe"
   Desc.lroInfo.objDesc = "Essbase executable."
   opt = ESB_STORE_OBJECT_API
   sts = EsbLROAddObject(hCtx, memCount, memComb, opt, Desc)
   Debug.Print "EsbLROAddObject: sts = " & sts

   Desc.ObjType = ESB_LROTYPE_URL_API
   Desc.lroInfo.ObjName = "www.oracle.com"
   Desc.lroInfo.objDesc = "Oracle homepage"
   opt = ESB_NOSTORE_OBJECT_API
   sts = EsbLROAddObject(hCtx, memCount, memComb, opt, Desc)
   Debug.Print "EsbLROAddObject: sts = " & sts
 
    Desc.ObjType = ESB_LROTYPE_CELLNOTE_API
    Desc.note = "Cell note 2"
    opt = ESB_NOSTORE_OBJECT_API
   sts = EsbLROAddObject(hCtx, memCount, memComb, opt, Desc)
    Debug.Print "EsbLROAddObject: sts = " & sts
End Sub

Public Sub ESB_LROGetCatalog()
   
   Dim Desc As ESB_LRODESC_API_T
   Dim Items As Integer
   Dim memCount As Long
   Dim memComb As String
   Dim i As Integer
   
   memCount = 5
   memComb = "Qtr1" & vbCrLf & "Profit" & vbCrLf & _
             "100" & vbCrLf & "East" & vbCrLf & "Scenario"
   'memComb = "Jan" & vbCrLf & "Sales" & _
   '          "Cola" & vbCrLf & "Utah" & _
   '          "Actual"
   
  sts = EsbLROGetCatalog(hCtx, memCount, memComb, Items)
   Debug.Print "EsbLROGetCatalog: sts = " & sts
   
   If sts = 0 Then
      For i = 1 To Items
        sts = EsbGetNextItem(hCtx, ESB_LRO_TYPE, Desc)
         Debug.Print "Desc.ObjType = " & Desc.ObjType
         Debug.Print "Desc.note = " & Desc.note
         Debug.Print "Desc.lroInfo.objDesc = " & Desc.lroInfo.objDesc
         Debug.Print "Desc.lroInfo.objName = " & Desc.lroInfo.ObjName
      Next i
   End If
End Sub

Sub ESB_CopyObject()
   Dim sts As Long
   Dim SrcApp As String
   Dim SrcDb As String
   Dim SrcObj As String
   Dim DestApp As String
   Dim DestDb As String
   Dim DestObj As String
   
   SrcApp = "Sample"
   SrcDb = "Basic"
   SrcObj = "Basic"
   
   DestApp = "Sample"
   DestDb = "Basic"
   DestObj = "Basic1"
   ObjType = ESB_OBJTYPE_OUTLINE
   
  sts = EsbCopyObject(hCtx, hDestCtx, ObjType, SrcApp, DestApp, _
   SrcDb, DestDb, SrcObj, DestObj)
   Debug.Print "EsbCopyObject: sts = " & sts
End Sub

Sub ESB_GetAssociatedAttributesInfo()
   Dim sts As Long
   Dim MbrName As String
   Dim AttrDimName As String
   Dim Count As Long
   Dim Attribinfo As ESB_ATTRIBUTEINFO_T
   Dim index As Integer
   Dim tempstring As String

   'MbrName = InputBox("Base member name", "Base Member Name")
   'AttrDimName = InputBox("Attribute Dimension Name (Optional)", "Attribute Dimension Name")

   MbrName = "em41666"
   AttrDimName = "Job Start Date"
  sts = EsbGetAssociatedAttributesInfo(hCtx, MbrName, AttrDimName, Count)
   Debug.Print "EsbGetAssociatedAttributesInfo: sts = " & sts
   
   Debug.Print "Associated Attr info for: " & MbrName

   For index = 1 To Count
     sts = EsbGetNextItem(hCtx, ESB_ATTRIBUTEINFO_TYPE, Attribinfo)
      'Debug.Print "Dim Name: " & Attribinfo.DimName
      Debug.Print "Attribute Dim Name: " & Attribinfo.DimName
      Debug.Print "Attribute Mbr Name: " & Attribinfo.MbrName

      ' NOTE: use of select case statement to discern (and act upon) type of attribute returned
      Select Case VarType(Attribinfo.Attribute)
         Case vbDouble
            Debug.Print "Data Type    : Numeric(Double)"
            Debug.Print "Data Value   : " & Attribinfo.Attribute
            Debug.Print ""
         Case vbBoolean
            Debug.Print "Data Type    : Boolean"
            Debug.Print "Data Value   : " & Attribinfo.Attribute
            Debug.Print ""
         Case vbDate
            Debug.Print "Data Type    : Date"
            Debug.Print "Data Value   : " & Attribinfo.Attribute
            Debug.Print ""
         Case vbString
            Debug.Print "Data Type    : String"
            Debug.Print "Data Value   : " & Attribinfo.Attribute
            Debug.Print ""
         End Select
      Debug.Print ""
   Next index
End Sub

Sub ESB_ListConnections()
   Dim Items As Integer
   Dim UserInfo As ESB_USERINFO_T
   Dim sts As Long
   
   sts = EsbListConnections(hCtx, Items)
   Debug.Print "EsbListConnections: sts = " & sts
   
   For N = 1 To Items
     sts = EsbGetNextItem(hCtx, ESB_USERINFO_TYPE, UserInfo)
      Debug.Print "EsbGetNextItem: sts = " & sts
   Next
End Sub

Sub ESB_ListRequests()
    Dim Items As Integer
    Dim ReqInfo As ESB_REQUESTINFO_T
    Dim sts As Long
    
    sts = EsbListRequests(hCtx, UserName, AppName, DbName, Items)
    Debug.Print "EsbListRequests: sts = " & sts
  
    For N = 1 To Items
     sts = EsbGetNextItem(hCtx, ESB_REQUESTINFO_TYPE, ReqInfo)
      Debug.Print "EsbGetNextItem: sts = " & sts
      Debug.Print "AppName: " & ReqInfo.AppName
      Debug.Print "DbName: " & ReqInfo.DbName
      Debug.Print "DbRequestCode: " & ReqInfo.DbRequestCode
      Debug.Print "LoginID: " & ReqInfo.LoginId
      Debug.Print "LoginSourceMachine: " & ReqInfo.LoginSourceMachine
      Debug.Print "RequestString: " & ReqInfo.RequestString
      Debug.Print "State: " & ReqInfo.State
      Debug.Print "TimeStarted: " & ReqInfo.TimeStarted
      Debug.Print "Username: " & ReqInfo.UserName
    Next
End Sub

Sub ESB_AddToGroup()
    Dim sts As Long
    Dim GroupName As String
    Dim User As String
    
    GroupName = "Group1"
    User = "user1"
    sts = EsbAddToGroup(hCtx, GroupName, User)
    Debug.Print "EsbAddToGroup sts: " & sts
End Sub

Sub ESB_GetGroupList()
   Dim Items As Integer
   Dim Group As String
   Dim GroupName As String * ESB_USERNAMELEN
   Dim sts As Long
   
   Group = "group1"
   sts = EsbGetGroupList(hCtx, Group, Items)
   Debug.Print "EsbGetGroupList: sts = " & sts
   
   For N = 1 To Items
    sts = EsbGetNextItem(hCtx, ESB_GROUPNAME_TYPE, ByVal GroupName)
     Debug.Print "EsbGetGroupList: sts = " & sts
     Debug.Print "User Name = " & GroupName
     MsgBox ("User Name = " & GroupName)
   Next
End Sub

Sub ESB_GetDatabaseState()
   Dim sts As Long
   Dim AppName As String
   Dim DbName As String
   Dim DbState As ESB_DBSTATE_T
   AppName = "Sample"
   DbName = "Basic"
   
  sts = EsbGetDatabaseState(hCtx, AppName, DbName, DbState)
   Debug.Print "EsbGetDatabaseState: sts = " & sts
End Sub


Sub ESB_CreateLocalContext()
   Dim sts As Long
   Dim User As String
   Dim Password As String
   Dim hCtx As Long
   
   '*********************
   ' Create Local Context
   '*********************
  sts = EsbCreateLocalContext(hInst, User, Password, hCtx)
End Sub

Sub ESB_Import()
   Dim sts          As Long
   Dim Rules        As ESB_OBJDEF_T
   Dim Data         As ESB_OBJDEF_T
   Dim User         As ESB_MBRUSER_T
   Dim ErrorName    As String
   Dim AbortOnError As Integer
   Dim hLocalCtx As Long
   
   '***************************************************************
   ' Need to create a local context, if files are not on the server
   '***************************************************************
  sts = EsbCreateLocalContext(hInst, "", "", hLocalCtx)
   Debug.Print "EsbCreateLocalContext sts: " & sts
   Data.hCtx = hLocalCtx
   Data.Type = ESB_OBJTYPE_TEXT
   Data.AppName = ""
   Data.DbName = ""
   Data.FileName = "F:\\testArea\\VBAPI\\calcdat.txt"

   '*********************************
   ' Rules file resides at the server
   '*********************************
   'Rules.hCtx = hCtx
   'Rules.Type = ESB_OBJTYPE_RULES
   'Rules.AppName = "Demo"
   'Rules.DbName = "Basic"
   'Rules.FileName = "Test"
   
   '********************************
   ' Data file resides at the server
   '********************************
   'Data.hCtx = hCtx
   'Data.Type = ESB_OBJTYPE_TEXT
   'Data.AppName = "Demo"
   'Data.DbName = "Basic"
   'Data.FileName = "Data"
   
   '********************************
   ' Specify file to redirect errors
   ' to if any
   '********************************
   ErrorName = "IMPORT.ERR"
   
   '*************************
   ' Abort on the first error
   '*************************
   AbortOnError = ESB_YES
   
   '*******
   ' Import
   '*******
  sts = EsbImport(hCtx, Rules, Data, User, ErrorName, AbortOnError)
   Debug.Print "EsbImport sts: " & sts
End Sub

Sub ESB_VerifyFilter()
   Dim sts As Long
   Dim AppName As String
   Dim DbName As String
   Dim Row As String
   
   AppName = "Sample"
   DbName = "Basic"
   
  sts = EsbVerifyFilter(hCtx, AppName, DbName)
   Debug.Print "EsbVerifyFilter sts: " & sts
   
   ' Initialize Filter Row
   Row = "@IDESCENDANTS(Scenario)"
  sts = EsbVerifyFilterRow(hCtx, Row) ' Initialize Filter Row
   Debug.Print "EsbVerifyFilterRow sts: " & sts
   
   Row = "@IDESCENDANTS(AAAA)"
  sts = EsbVerifyFilterRow(hCtx, Row)
   Debug.Print "EsbVerifyFilterRow sts: " & sts
   
  sts = EsbVerifyFilterRow(hCtx, ByVal 0&)
   Debug.Print "EsbVerifyFilterRow sts: " & sts
End Sub

Sub Test()
    strComputer = "."
    Const ForReading = 1
    Const ForWriting = 2
    Const ForAppending = 8
    '==============================================================
    Const Data_Path = "F:\Testarea\temp\"
    Const FileName = "process.txt"
    
    Set fso = CreateObject("Scripting.FileSystemObject")
    If Not fso.FileExists(Data_Path & FileName) Then
     Set f = fso.OpenTextFile(Data_Path & FileName, 2, True)
    Else
     Set f = fso.OpenTextFile(Data_Path & FileName, 8)
    End If
    
    Set objWMIService = GetObject("winmgmts:" & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
    Set colProcessList = objWMIService.ExecQuery("Select * from Win32_Process")
    For Each objProcess In colProcessList
        f.WriteLine "Process " & objProcess.Name
    Next
End Sub

Sub ESB_CreateGLDrillThru()
   Dim sts          As Long
   Dim url          As ESB_DURLINFO_T
   Dim cppDrillRegions(0 To 1) As String
   
   '***************************************************************
   ' Need to create a local context, if files are not on the server
   '***************************************************************
   url.bIsLevel0 = 0
   
   cppDrillRegions(0) = "sales"
   cppDrillRegions(1) = "cogs"
   url.cpURLXML = "Testing"
   url.cpURLName = "VB URL7"
   url.iURLXMLSize = 8
   
   sts = EsbCreateDrillThruURL(hCtx, cppDrillRegions, url)
  
   Debug.Print "EsbCreateDrillThruURL sts: " & sts

End Sub

Sub ESB_UpdateGLDrillThru()
   Dim sts                       As Long
   Dim url                       As ESB_DURLINFO_T
   Dim cppDrillRegions(0 To 1)   As String
   Dim bMerge                    As Integer

   '***************************************************************
   ' Need to create a local context, if files are not on the server
   '***************************************************************
   url.bIsLevel0 = 0
   bMerge = ESB_TRUE

   cppDrillRegions(0) = "qtr1"
   url.cpURLXML = "Testing"
   url.cpURLName = "VB URL7"
   url.iURLXMLSize = 8

   sts = EsbUpdateDrillThruURL(hCtx, cppDrillRegions, url, bMerge)

   Debug.Print "EsbUpdateDrillThruURL sts: " & sts
End Sub

Sub ESB_DeleteGLDrillThru()
   Dim URLName      As String
   
   URLName = "VB URL7"
   sts = EsbDeleteDrillThruURL(hCtx, URLName)
  
   Debug.Print "EsbDeleteDrillThruURL sts: " & sts
End Sub

Sub ESB_GetGLDrillThru()
   Dim URLName      As String
   Dim url          As ESB_DURLINFO_T
   Dim intX         As Integer
   Dim cppDrillRegions  As Variant
         
   URLName = "VB URL2"
   sts = EsbGetDrillThruURL(hCtx, URLName, url, cppDrillRegions)
  
   Debug.Print "EsbGetDrillThruURL sts: " & sts
   
   If sts = 0 Then
    Debug.Print "URL Name: " & url.cpURLName
    Debug.Print "URL XML: " & url.cpURLXML
   
    For intX = LBound(cppDrillRegions) To UBound(cppDrillRegions)

    Debug.Print "URL Region: " & cppDrillRegions(intX)

    Next
   End If
End Sub

Sub ESB_ListGLDrillThru()
   Dim intX         As Integer
   Dim URLNames  As Variant
         
   sts = EsbListDrillThruURLs(hCtx, URLNames)
  
   If sts = 0 Then
       Debug.Print "EsbListDrillThruURL sts: " & sts
   
       For intX = LBound(URLNames) To UBound(URLNames)

       Debug.Print "URL Name: " & URLNames(intX)

       Next
   End If
End Sub

Sub ESB_GetCellDrillThruReports()
   Dim intX         As Integer
   Dim mbrs(0 To 4) As String
   Dim pURLXMLLens  As Variant
   Dim pURLXMLs  As Variant
         
   mbrs(0) = "sales"
   mbrs(1) = "jan"
   mbrs(2) = "New York"
   mbrs(3) = "actual"
   mbrs(4) = "100-10"
   
   sts = EsbGetCellDrillThruReports(hCtx, mbrs, pURLXMLLens, pURLXMLs)
  
   If sts = 0 Then
   
       Debug.Print "EsbGetCellDrillThruReports sts: " & sts
   
       For intX = LBound(pURLXMLLens) To UBound(pURLXMLLens)

       Debug.Print "URL XML: " & intX
       Debug.Print "URL XML Len: " & pURLXMLLens(intX)
       Debug.Print "URL XML String: " & pURLXMLs(intX)

       Next
   End If
   
   mbrs(0) = "profit"
   sts = EsbGetCellDrillThruReports(hCtx, mbrs, pURLXMLLens, pURLXMLs)
  
   If sts = 0 Then
   
       Debug.Print "EsbGetCellDrillThruReports sts: " & sts
   
       For intX = LBound(pURLXMLLens) To UBound(pURLXMLLens)

       Debug.Print "URL XML: " & intX
       Debug.Print "URL XML Len: " & pURLXMLLens(intX)
       Debug.Print "URL XML String: " & pURLXMLs(intX)

       Next
   End If
End Sub

Sub Main()
    'Test
    ESB_Init
    'ESB_CreateLocalContext
    'ESB_AutoLogin
    ESB_Login
    'ESB_LoginSetPassword
    ESB_SetActive
    ESB_CreateGLDrillThru
    ESB_UpdateGLDrillThru
    ESB_GetGLDrillThru
    ESB_ListGLDrillThru
    ESB_GetCellDrillThruReports
    ESB_DeleteGLDrillThru
    'ESB_GetGLDrillThru
    'ESB_ListGLDrillThru
    ESB_GetCellDrillThruReports
    'ESB_SetUser
    'ESB_GetUser
    'ESB_GetMessage
    'ESB_Import
    'ESB_GetVersion
    'ESB_GetDatabaseInfo
    'ESB_GetDatabaseState
    'ESB_GetDatabaseStats
    'ESB_GetDatabaseAccess
    'ESB_GetGroupList
    'ESB_ListConnections
    'ESB_ListRequests
    'ESB_GetAssociatedAttributesInfo
    'ESb_GetStoresInfo
    'ESB_OtlGetMemberAlias
    'ESB_AddAliasCombination
    'ESB_CreateGroup
    'ESB_LROAddObject
    'ESB_LROGetCatalog
    'ESB_LROListObjects
    'ESB_LROPurgeObjects

   'ESB_CopyObject
   'ESB_PartitionReadDefFile
   'ESB_PartitionWriteDefFile
   'ESB_PartitionReplaceDefFile
   'ESB_PartitionValidateDefinition
   'ESB_PartitionValidateLocal
   'ESB_PartitionReadOtlChangeFile
   
   'ESB_AddToGroup
   'ESB_GetGroupList
   'ESB_VerifyFilter
   ESB_Logout
   ESB_Term
End Sub