Edit

Share via

Cellset example (VB)

  • Article

Applies to: Access 2013 | Access 2016

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

See also

Support and feedback

Have questions or feedback about Office VBA or this documentation? Please see Office VBA support and feedback for guidance about the ways you can receive support and provide feedback.