Cellset の例 (VB)

この Visual Basic プロジェクトは、ADO MD を使用してキューブ データにアクセスするための基本的な方法を示しています。列と行のヘッダーのメンバ キャプションを表示し、次にセルセット内にある特定のセルの書式設定された値を表示します。

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