Cellset Example (VB)

This Visual Basic project demonstrates the basics of using ADO MD to access cube data. It displays member captions for column and row headers, then displays formatted values of specific cells within the cellset.

Sub cmdCellSettoDebugWindow_Click()
    On Error GoTo Error_cmdCellSettoDebugWindow_Click

    Dim cat As New ADOMD.Catalog
    Dim cst As New ADOMD.CellSet
    Dim strServer As String
    Dim strSource As String
    Dim strColumnHeader As String
    Dim strRowText As String
    Dim i As Integer
    Dim j As Integer
    Dim k As Integer

    Screen.MousePointer = vbHourglass
    
    '*-----------------------------------------------------------------------
    '* Set Server to Local Host
    '*-----------------------------------------------------------------------
    strServer = "localhost"

    '*-----------------------------------------------------------------------
    '* Set MDX query string Source
    '*-----------------------------------------------------------------------
    strSource = "SELECT {[Measures].members} ON COLUMNS," & _
        "NON EMPTY [Store].[Store City].members ON ROWS FROM Sales"
        
    '*-----------------------------------------------------------------------
    '* Set Active Connection
    '*-----------------------------------------------------------------------
    cat.ActiveConnection = "Data Source=" & strServer & ";Provider=msolap;"

    '*-----------------------------------------------------------------------
    '* Set Cell Set source to MDX query string
    '*-----------------------------------------------------------------------
    cst.Source = strSource

    '*-----------------------------------------------------------------------
    '* Set Cell Sets active connection to current connection
    '*-----------------------------------------------------------------------
    Set cst.ActiveConnection = cat.ActiveConnection
    
    '*-----------------------------------------------------------------------
    '* Open Cell Set
    '*-----------------------------------------------------------------------
    cst.Open

    '*-----------------------------------------------------------------------
    '* Allow space for Row Header Text
    '*-----------------------------------------------------------------------
    strColumnHeader = vbTab & vbTab & vbTab & vbTab & vbTab & vbTab

    '*-----------------------------------------------------------------------
    '* Loop through Column Headers
    '*-----------------------------------------------------------------------
    For i = 0 To cst.Axes(0).Positions.Count - 1
        strColumnHeader = strColumnHeader & _
            cst.Axes(0).Positions(i).Members(0).Caption & vbTab & _
            vbTab & vbTab & vbTab
    Next
    Debug.Print vbTab & strColumnHeader & vbCrLf

    '*-----------------------------------------------------------------------
    '* Loop through Row Headers and Provide data for each row
    '*-----------------------------------------------------------------------
    strRowText = ""
    For j = 0 To cst.Axes(1).Positions.Count - 1
        strRowText = strRowText & _
            cst.Axes(1).Positions(j).Members(0).Caption & vbTab & _
                vbTab & vbTab & vbTab
        For k = 0 To cst.Axes(0).Positions.Count - 1
            strRowText = strRowText & cst(k, j).FormattedValue & _
                vbTab & vbTab & vbTab & vbTab
        Next
        Debug.Print strRowText & vbCrLf
        strRowText = ""
    Next

    Screen.MousePointer = vbDefault
    
    Exit Sub

Error_cmdCellSettoDebugWindow_Click:
   Beep
   Screen.MousePointer = vbDefault
   Set cat = Nothing
   Set cst = Nothing
   MsgBox "The Following Error has occurred:" & vbCrLf & _
      Err.Description, vbCritical, " Error!"
   Exit Sub
End Sub