home *** CD-ROM | disk | FTP | other *** search
/ io Programmo 32 / IOPROG_32.ISO / SOFT / SqlEval7 / MSOLAP / samples / Samples.exe / VbAdoSimple / frmVBADOSimple.frm (.txt) next >
Encoding:
Visual Basic Form  |  1998-10-30  |  4.7 KB  |  95 lines
  1. VERSION 5.00
  2. Begin VB.Form frmVBADOSimple 
  3.    Caption         =   "VB ADO Simple"
  4.    ClientHeight    =   1200
  5.    ClientLeft      =   60
  6.    ClientTop       =   345
  7.    ClientWidth     =   4005
  8.    LinkTopic       =   "Form1"
  9.    ScaleHeight     =   1200
  10.    ScaleWidth      =   4005
  11.    StartUpPosition =   3  'Windows Default
  12.    Begin VB.CommandButton cmdCellSettoDebugWindow 
  13.       Caption         =   "Write Cell Set info to Debug Window"
  14.       Height          =   510
  15.       Left            =   270
  16.       TabIndex        =   0
  17.       Top             =   315
  18.       Width           =   3345
  19.    End
  20. Attribute VB_Name = "frmVBADOSimple"
  21. Attribute VB_GlobalNameSpace = False
  22. Attribute VB_Creatable = False
  23. Attribute VB_PredeclaredId = True
  24. Attribute VB_Exposed = False
  25. Private Sub cmdCellSettoDebugWindow_Click()
  26. Dim cat As New ADOMD.Catalog
  27. Dim cst As New ADOMD.Cellset
  28. Dim i As Integer
  29. Dim j As Integer
  30. Dim strServer As String
  31. Dim strSource As String
  32. Dim strColumnHeader As String
  33. Dim strRowText As String
  34. On Error GoTo Error_cmdCellSettoDebugWindow_Click
  35. Screen.MousePointer = vbHourglass
  36. '*--------------------------------------------------------------------------------------------------
  37. '* Set Server to Local Host
  38. '*--------------------------------------------------------------------------------------------------
  39.     strServer = "LOCALHOST"
  40. '*--------------------------------------------------------------------------------------------------
  41. '* Set MDX query string Source
  42. '*--------------------------------------------------------------------------------------------------
  43.     strSource = strSource & "SELECT "
  44.     strSource = strSource & "{[Measures].members} ON COLUMNS,"
  45.     strSource = strSource & "NON EMPTY [Store].[Store City].members ON ROWS"
  46.     strSource = strSource & " FROM Sales"
  47. '*--------------------------------------------------------------------------------------------------
  48. '* Set Active Connection
  49. '*--------------------------------------------------------------------------------------------------
  50.         cat.ActiveConnection = "Data Source=" & strServer & ";Provider=msolap;"
  51. '*--------------------------------------------------------------------------------------------------
  52. '* Set Cell Set source to MDX query string
  53. '*--------------------------------------------------------------------------------------------------
  54.         cst.Source = strSource
  55. '*--------------------------------------------------------------------------------------------------
  56. '* Set Cell Sets active connection to current connection
  57. '*--------------------------------------------------------------------------------------------------
  58.     Set cst.ActiveConnection = cat.ActiveConnection
  59. '*--------------------------------------------------------------------------------------------------
  60. '* Open Cell Set
  61. '*--------------------------------------------------------------------------------------------------
  62.     cst.Open
  63. '*--------------------------------------------------------------------------------------------------
  64. '* Allow space for Row Header Text
  65. '*--------------------------------------------------------------------------------------------------
  66. strColumnHeader = vbTab & vbTab & vbTab & vbTab & vbTab & vbTab
  67. '*--------------------------------------------------------------------------------------------------
  68. '* Loop through Column Headers
  69. '*--------------------------------------------------------------------------------------------------
  70.        For i = 0 To cst.Axes(0).Positions.Count - 1
  71.             strColumnHeader = strColumnHeader & cst.Axes(0).Positions(i).Members(0).Caption & vbTab & vbTab & vbTab & vbTab
  72.         Next
  73.         Debug.Print vbTab & strColumnHeader & vbCrLf
  74. '*--------------------------------------------------------------------------------------------------
  75. '* Loop through Row Headers and Provide data for each row
  76. '*--------------------------------------------------------------------------------------------------
  77.         strRowText = ""
  78.         For j = 0 To cst.Axes(1).Positions.Count - 1
  79.             strRowText = strRowText & cst.Axes(1).Positions(j).Members(0).Caption & vbTab & vbTab & vbTab & vbTab
  80.             For k = 0 To cst.Axes(0).Positions.Count - 1
  81.                  strRowText = strRowText & cst(k, j).FormattedValue & vbTab & vbTab & vbTab & vbTab
  82.             Next
  83.             Debug.Print strRowText & vbCrLf
  84.             strRowText = ""
  85.         Next
  86.         
  87.     Screen.MousePointer = vbDefault
  88. Exit Sub
  89. Error_cmdCellSettoDebugWindow_Click:
  90.    Beep
  91.    Screen.MousePointer = vbDefault
  92.    MsgBox "The Following Error has occurred:" & vbCrLf & Err.Description, vbCritical, " Error!"
  93.    Exit Sub
  94. End Sub
  95.