How To Use ADOMD to Return Out of Process Cellset (234552)

MORE INFORMATION

Server

1. Create a new Visual Basic ActiveX EXE Project. Class 1 is created by default.
2. Set a Project Reference to the Microsoft ActiveX Data Objects (Multi-Dimensional) 1.0 Object Library.
3. Change the name of the Project to ADOBusObj.
4. Paste the following code into Class1:

   Private strSQL As String
   Private strConnect As String
   Dim adoCat As New ADOMD.Catalog
   
   Public Function GetRs() As ADOMD.CellSet
       Dim adoCst As New ADOMD.CellSet
   
       With adoCst
           Set adoCst.ActiveConnection = adoCat.ActiveConnection
           .Source = strSQL
           .Open
       End With
       
       Set GetRs = adoCst
   End Function
   
   Private Property Get ConnectStr() As String
       ConnectStr = strConnect
   End Property
   
   Private Property Let ConnectStr(strCn As String)
       strConnect = strCn
   End Property
   
   Public Property Get SQL() As String
       SQL = strSQL
   End Property
   
   Public Property Let SQL(nSQL As String)
       strSQL = nSQL
   End Property
   
   Public Sub ADOMDConnect(strConnect As String, Optional CmdTimeOut As Integer = 20)
       adoCat.ActiveConnection = strConnect
       ConnectStr = adoCn
   End Sub
   					

Client

1. Create a new Visual Basic Standard EXE Project. Form1 is created by default.
2. Set a Project Reference to the Microsoft ActiveX Data Objects (version 2.0 or later) Library.
3. Set a Project Reference to the ActiveX EXE ADOBusObj created earlier.
4. Change the connection string and the SQL string to reflect your OLAP server's configuration.
5. Paste the following code into the General Declarations section of Form1:
   
   NOTE: A cube query (MDX query) has the following layout that defines the number of Axes in the query. The count of the fields referenced between SELECT and FROM in the MDX statement are the number of Axes in the query.

   SELECT <axis_specification> [, <axis_specification>...] FROM <cube_specification>
   WHERE <slicer_specification>
   					

   Option Explicit
   Const strConnect = "Data Source=<DataSource>;PROVIDER=MSOLAP;INITIAL CATALOG=FoodMart"
   
   Private Sub Form_Click()
       On Error GoTo ErrorHandler
   
       Dim adoCst As ADOMD.Cellset
       Dim objAdoData As ADOBusObj.Class1
       Dim strOutput As String
       Dim intStrLen As Integer
       Dim intDC0 As Integer
       Dim intDC1 As Integer
       Dim intPC0 As Integer
       Dim intPC1 As Integer
       Dim i As Integer
       Dim j As Integer
       Dim k As Integer
       
       Set objAdoData = CreateObject("ADOBusObj.Class1")
       With objAdoData
           .SQL = "Select {[Measures].members} On Columns," & _
                      "Non Empty [Store].[Store City].members " & _
                      "Properties [Store].[Store Type], [Store].[Store Manager] " & _
                      "On Rows From Sales"
           .ADOMDConnect strConnect, 20 'Establish connection.
       End With
   
       'Return the Cellset from MD Data Object.
       Set adoCst = objAdoData.GetRs
       
       'it is known up front there are two axes for this query so,
       'just check each axis for number of dimensions.
       intDC0 = adoCst.Axes(0).DimensionCount - 1
       intDC1 = adoCst.Axes(1).DimensionCount - 1
       intPC0 = adoCst.Axes(0).Positions.Count - 1
       intPC1 = adoCst.Axes(1).Positions.Count - 1
   
       For i = 0 To intDC0
           For j = 0 To intPC0
               intStrLen = Len(adoCst.Axes(0).Positions(j).Members(i).Caption)
               If intStrLen > 15 Then intStrLen = 0
               strOutput = strOutput & "[" & adoCst.Axes(0).Positions(j).Members(i).Caption & "]" & _
                                 String(3, vbTab) & Space(15 - intStrLen)
           Next j
       Next i
       
       Debug.Print strOutput & vbCrLf
       
       For i = 0 To intPC1
           strOutput = ""
           For j = 0 To intDC1
               Debug.Print "-- " & adoCst.Axes(1).Positions(i).Members(j).Caption & " --"
           Next j
           For k = 0 To intPC0
               intStrLen = Len(adoCst(k, i).FormattedValue)
               If intStrLen > 15 Then intStrLen = 0
               strOutput = strOutput & adoCst(k, i).FormattedValue & _
                                 Space(15 - intStrLen) & String(4, vbTab)
           Next k
           Debug.Print strOutput
       Next i
       
       MsgBox "Success", vbOKOnly, "MD Data Object"
       Exit Sub
       
   ErrorHandler:
       MsgBox "Change Failed:" & vbCrLf & _
                     Err.Number & _
                     vbCrLf & Err.Description, _
                     vbOKOnly, "Data Object"
       Exit Sub
   End Sub