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.
Private Sub cmdCellSettoDebugWindow_Click()
Dim cat As New ADOMD.Catalog
Dim cst As New ADOMD.Cellset
Dim i As Integer
Dim j As Integer
Dim strServer As String
Dim strSource As String
Dim strColumnHeader As String
Dim strRowText As String

On Error GoTo Error_cmdCellSettoDebugWindow_Click
Screen.MousePointer = vbHourglass
'*-----------------------------------------------------------------------
'* Set Server to Local Host
'*-----------------------------------------------------------------------
    strServer = "LOCALHOST"

'*-----------------------------------------------------------------------
'* Set MDX query string Source
'*-----------------------------------------------------------------------
    strSource = strSource & "SELECT "
    strSource = strSource & "{[Measures].members} ON COLUMNS,"
    strSource = strSource & _
        "NON EMPTY [Store].[Store City].members ON ROWS"
    strSource = strSource & " 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
   MsgBox "The Following Error has occurred:" & vbCrLf & _
      Err.Description, vbCritical, " Error!"
   Exit Sub
End Sub