io Programmo 32/IOPROG_32.ISO/SOFT/SqlEval7/MSOLAP/samples/Samples.exe/VbDSOCreateSmallCube/frmMain.frm

Visual Basic Form | 1998-10-30 | 39.9 KB | 916 lines

VERSION 5.00
Begin VB.Form frmMain
   Caption         =   "Form1"
   ClientHeight    =   5976
   ClientLeft      =   48
   ClientTop       =   276
   ClientWidth     =   4128
   LinkTopic       =   "Form1"
   ScaleHeight     =   5976
   ScaleWidth      =   4128
   StartUpPosition =   3  'Windows Default
   Begin VB.CommandButton btnBuildCube
      Caption         =   "Build Cube"
      Height          =   252
      Left            =   2400
      TabIndex        =   13
      Top             =   240
      Width           =   1692
   End
   Begin VB.CommandButton btnDone
      Caption         =   "Done"
      Height          =   252
      Left            =   1440
      TabIndex        =   3
      Top             =   5400
      Width           =   1212
   End
   Begin VB.Frame frmProgramSteps
      Caption         =   "Steps to Make a Cube"
      Height          =   5052
      Left            =   120
      TabIndex        =   2
      Top             =   600
      Width           =   3972
      Begin VB.CheckBox chkProgramStep
         Caption         =   "Step 9 - Write Enable the Cube"
         Enabled         =   0   'False
         Height          =   252
         Index           =   8
         Left            =   240
         TabIndex        =   12
         Top             =   4200
         Width           =   3012
      End
      Begin VB.CheckBox chkProgramStep
         Caption         =   "Step -8 Process the Database"
         Enabled         =   0   'False
         Height          =   252
         Index           =   7
         Left            =   240
         TabIndex        =   11
         Top             =   3720
         Width           =   3132
      End
      Begin VB.CheckBox chkProgramStep
         Caption         =   "Step 7 - Create the Cube"
         Enabled         =   0   'False
         Height          =   252
         Index           =   6
         Left            =   240
         TabIndex        =   10
         Top             =   3240
         Width           =   3132
      End
      Begin VB.CheckBox chkProgramStep
         Caption         =   "Step 6 - Create the ""Product"" Dimension"
         Enabled         =   0   'False
         Height          =   372
         Index           =   5
         Left            =   240
         TabIndex        =   9
         Top             =   2760
         Width           =   3612
      End
      Begin VB.CheckBox chkProgramStep
         Caption         =   "Step 5 - Create the ""Customer"" Dimension"
         Enabled         =   0   'False
         Height          =   252
         Index           =   4
         Left            =   240
         TabIndex        =   8
         Top             =   2280
         Width           =   3492
      End
      Begin VB.CheckBox chkProgramStep
         Caption         =   "Step 4 - Create a New DataSource"
         Enabled         =   0   'False
         Height          =   372
         Index           =   3
         Left            =   240
         TabIndex        =   7
         Top             =   1680
         Width           =   3492
      End
      Begin VB.CheckBox chkProgramStep
         Caption         =   "Step 3 - Create a new Database"
         Enabled         =   0   'False
         Height          =   252
         Index           =   2
         Left            =   240
         TabIndex        =   6
         Top             =   1200
         Width           =   3132
      End
      Begin VB.CheckBox chkProgramStep
         Caption         =   "Step 2 - Connect to Server"
         Enabled         =   0   'False
         Height          =   252
         Index           =   1
         Left            =   240
         TabIndex        =   5
         Top             =   720
         Width           =   2772
      End
      Begin VB.CheckBox chkProgramStep
         Caption         =   "Step 1 - Initialize"
         Enabled         =   0   'False
         Height          =   252
         Index           =   0
         Left            =   240
         TabIndex        =   4
         Top             =   240
         Width           =   2412
      End
   End
   Begin VB.TextBox txtServerName
      Height          =   288
      Left            =   120
      TabIndex        =   0
      Text            =   "LocalHost"
      Top             =   240
      Width           =   1932
   End
   Begin VB.Label Label1
      Caption         =   "Enter Server name"
      Height          =   252
      Left            =   120
      TabIndex        =   1
      Top             =   0
      Width           =   1932
   End
Attribute VB_Name = "frmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Create a small cube - Example Program.
' Creates a small cube from the foodmart database intended to be used
' with the writeback example program. This cube has the following properties:
' Dimensions:
'               Products
'               Customers
' Measures:
'               Sales_Fact_1998
'(C) Copyright 1998, Microsoft Corporation. All rights reserved.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Option Explicit
Option Compare Text
' Declare module level (global) variables.
Public m_dsoServer   As DSO.Server
Public m_dsoDatabase As DSO.MDStore
Public m_dsoCube     As DSO.MDStore
' Declare an integer to keep track of the program steps as they are executed.
Private m_count As Integer
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' btnBuldCube_Click() - Executed when the user pressed the "Build Cube" button.
' Runs through each step in building a cube, and checks off each step as it goes.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Sub btnBuildCube_Click()
    ' Initialize the server and close it if is already open.
    DoNextStep
    Initialize
    FinishStep
    ' Connect to the server specified in ther txtServerName txt box.
    DoNextStep
    ConnectToServer
    FinishStep
    ' Create a Database on that server.
    DoNextStep
    CreateDatabase
    FinishStep
    'Create a Datasource in that Database.
    DoNextStep
    CreateDatasource
    FinishStep
    'Create the Customer Dimension.
    DoNextStep
    CreateDimensionCustomer
    FinishStep

    'Create the Product Dimension.
    DoNextStep
    CreateDimensionProduct
    FinishStep
    ' Create the cube and save it in the meta data repository.
    DoNextStep
    CreateCube
    FinishStep
    ' Process the cube.
    DoNextStep
    ProcessDatabase
    FinishStep
    ' After this procedure has been completed, write enable the cube
    ' by running the VbDsoWriteEnable sample.
End Sub
' Unloads the form and exits the program.
Private Sub btnDone_Click()
    Unload Me
End Sub
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' DoNextStep() - 'Enables' Each program step check mark showing what is
' currently in progress.
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Sub DoNextStep()
    Screen.MousePointer = vbHourglass
    chkProgramStep(m_count).Enabled = True
    chkProgramStep(m_count).Value = 0
    chkProgramStep(m_count).ForeColor = vbRed
    chkProgramStep(m_count).Refresh
    DoEvents
End Sub
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' FinishStep() - Checks off the current program setp check mark as each
' Program Step is accomplished. Increments the program step counter.
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Sub FinishStep()
    chkProgramStep(m_count).Value = 1
    chkProgramStep(m_count).Refresh
    chkProgramStep(m_count).ForeColor = vbBlack
    DoEvents
    m_count = m_count + 1
    Screen.MousePointer = vbDefault
End Sub
Private Sub Form_Load()
    Me.Refresh
    m_count = 0
End Sub
'   Initialize - initialize the sample application
Public Sub Initialize()
    ' If the DSO server object has already been in use
    '   then call CloseServer method
    ' NOTE: CloseServer method releases all of the resources
    '       acquired by DSO.  It is important to call this
    '       method when the DSO server object is not needed
    '       any longer
    If Not m_dsoServer Is Nothing Then
        m_dsoServer.CloseServer
    End If
End Sub
'   ConnectToServer - create and connect to the DSO server
Public Sub ConnectToServer()
    ' create an instance of the server object
    Dim dsoServer As DSO.Server
    Set dsoServer = New DSO.Server
    ' connect to the server
    On Error GoTo Err_Connect
    dsoServer.Connect frmMain.txtServerName

    ' store the reference to the server object
    ' so that other methods can use it
    Set m_dsoServer = dsoServer
    Debug.Print 'Connected to server " & m_dsoServer.name
Exit Sub
Err_Connect:
    ' Failed to connect to the server.
    ' Possible reasons:
    '   - the Microsoft SQL Server OLAP Server is not running
    '   - the machine on which the OLAP Server is running cannot be reached
    '   - the machine on which DSO application is running is not connected
    '       to the network
    '   - you are not a member of the OLAP Administrators user group on the
    '       server machine
End Sub
'   CreateDatabase - create new database
Public Sub CreateDatabase()
    ' call the database "DSOSample"
    Dim sDatabaseName As String
    sDatabaseName = "FoodMart"
    ' check if a database with the same name
    ' already exists on the server
    If m_dsoServer.MDStores.Find(sDatabaseName) Then

        Set m_dsoDatabase = m_dsoServer.MDStores("FoodMart")
        Debug.Print "Found Database."
    Else
        ' create the new database
        On Error GoTo Err_CreateDatabase
        Dim dsoDatabase As DSO.MDStore
        Set dsoDatabase = m_dsoServer.MDStores.AddNew(sDatabaseName)

        ' set the database description
        dsoDatabase.Description = "SampleDSO database contains Warehouse cube."

        ' save the database definition in the OLAP server's metadata repository
        On Error GoTo Err_Update
        dsoDatabase.Update
        Debug.Print "Database created."
        ' store the reference to the database object
        ' so that other methods can use it
        Set m_dsoDatabase = dsoDatabase
    End If
Exit Sub
Err_DeleteDatabase:
    ' Failed to remove the database from the server.
    ' Possible reasons:
    '   - the OLAP server is not running or unreachable
    '   - the database is being used by another DSO application
Err_CreateDatabase:
    ' Failed to create the database on the server.
    ' Possible reasons:
    '   - the OLAP server is not running or unreachable
    '   - the DSO server object is being locked by another DSO application
    '       the server object is locked while AddNew method is executing on
    '       the server's MDStores collection
    '   - the metadata repository is unreachable
Err_Update:
    ' Failed to persist the database definition in the metadata repository
    ' Possible reasons:
    '   - the metadata repository is unreachable
    '       you can see where the metadata repository resides by looking
    '       up the following registry entry:
    '       HKEY_LOCAL_MACHINE\Software\Microsoft\OLAP Server\Server Connection Info
    '           Repository Connection String
    '   - the DSO database object is being locked by another DSO application
    '       it is not possible for two DSO apps to persist the same object
    '       at the same time
    '       it is not possible to persist a DSO object, it another DSO app
    '       has explicitly locked it
    MsgBox "Create database failed" & vbCrLf & Err.Description
End Sub
'   CreateDatasource - create the new datasource
Public Sub CreateDatasource()
    ' create the new datasource that points to the
    ' sample FoodMart database
    On Error GoTo Err_CreateDatasource
    Dim dsoDatasource As DSO.DataSource
        Set dsoDatasource = m_dsoDatabase.DataSources.AddNew("Foodmart Sample Database")

        ' set the OleDB connection string
        '   the connection string is used to establish the connection
        '   to the relational database that contains the dimension and
        '   fact tables
        ' we will use OleDB provider for ODBC drivers
        dsoDatasource.ConnectionString = _
                "Provider=MSDASQL.1;Data Source=FoodMart;Connect Timeout=15"

        ' save the datasource definition in the metadata repository
        On Error GoTo Err_Update
        dsoDatasource.Update
        Debug.Print "Datasource added to database."
Exit Sub
Err_CreateDatasource:
    ' Failed to create the datasource.
    ' Possible reasons:
    '   - the DSO database object is being locked by another DSO application
    '       a DSO object is locked while AddNew method is executing on
    '       one of its collections (Datasources, MDStores, ...)
    '   - the metadata repository is unreachable
Err_Update:
    ' Failed to persist the datasource definition in the metadata repository
    ' Possible reasons:
    '   - the metadata repository is unreachable
    '       you can see where the metadata repository resides by looking
    '       up the following registry entry:
    '       HKEY_LOCAL_MACHINE\Software\Microsoft\OLAP Server\Server Connection Info
    '           Repository Connection String
    '   - the DSO datasource object is being locked by another DSO application
    '       it is not possible for two DSO apps to persist the same object
    '       at the same time
    '       it is not possible to persist a DSO object, it another DSO app
    '       has explicitly locked it
    MsgBox "Create datasource failed" & vbCrLf & Err.Description
End Sub
'   CreateDimensionCustomer - create the Customer dimension
'   NOTE: the Customer dimension is an example of a dimension
'         that is based on one dimension table (star schema)
Public Sub CreateDimensionCustomer()
    ' create the Customer dimension in the database's
    ' Dimensions collection
    On Error GoTo Err_Create
    Dim dsoDimension As DSO.Dimension
    Set dsoDimension = m_dsoDatabase.Dimensions.AddNew("Customer")
    ' set the dimension description
    dsoDimension.Description = "The Customers hierarchy"
    ' set the dimension's datasource
    Set dsoDimension.DataSource = m_dsoDatabase.DataSources("Foodmart Sample Database")
    ' get the quoting characters from the datasource
    Dim sLQuote As String, sRQuote As String
    sLQuote = dsoDimension.DataSource.OpenQuoteChar
    sRQuote = dsoDimension.DataSource.CloseQuoteChar
    ' set the dimension type
    dsoDimension.DimensionType = dimRegular
    ' set the comma separeted list of the dimension tables
    ' NOTE: the tables must be quoted
    ' the Customer dimension uses only the "Customer" table
    dsoDimension.FromClause = sLQuote & "customer" & sRQuote

    ' define the joins between tables used by this dimension
    ' the format of this property is
    '   (table1.columnX = table2.columnY) and (table2.columnZ = table3.columnW)
    ' since the Customer dimension is based on only one table, we have no joins
    dsoDimension.JoinClause = ""
    '
    ' create dimension levels
    '
    Dim dsoLevel As DSO.Level
    '
    ' create the All level
    '   the All level is the top-most level in the dimension hierarcy
    On Error GoTo Err_Create
    Set dsoLevel = dsoDimension.Levels.AddNew("All")
    ' set the level type
    dsoLevel.LevelType = levAll
    ' the All level has only one member
    ' set the MemberKeyColumn of the All level to a constant
    ' this constant is at the same time the name of that single member
    dsoLevel.MemberKeyColumn = "All Customers"
    '
    ' create the Customer Country level
    '   the Customer Country level contains all of the countries
    On Error GoTo Err_Create
    Set dsoLevel = dsoDimension.Levels.AddNew("Customer Country")
    ' set the level type
    dsoLevel.LevelType = levRegular
    ' define which column contains the level member keys
    ' sLQuote and sRQuote are obtained from dsoDimension.Datasource
    ' NOTE: the tables and columns must be quoted using the quoting
    '       characters obtained from the dimension's datasource
    dsoLevel.MemberKeyColumn = sLQuote & "customer" & sRQuote & "." & _
                               sLQuote & "country" & sRQuote
    ' tell DSO how many members this level has
    ' this information will be used during the design of aggregations
    '   when determining the optimal set of aggregations
    ' there are 3 countries in the "Customer" table: Mexico, Canada, and USA
    dsoLevel.EstimatedSize = 3
    ' this level contains unique members
    dsoLevel.IsUnique = True
    ' DSO needs to know what is the type and maximum size of the members keys
    ' NOTE: the ColumnSize property needs to be set only for
    '       levels that have string members
    dsoLevel.ColumnType = adChar
    dsoLevel.ColumnSize = 6         ' the longest members ("Mexico", "Canada")
                                    ' can fit in 6 characters
    ' specify how should the level members be ordered
    ' we want the countries ordered by Name
    dsoLevel.Ordering = orderName
    '
    ' create the Customer State level
    '   the Customer State level contains all of the states
    On Error GoTo Err_Create
    Set dsoLevel = dsoDimension.Levels.AddNew("Customer State")
    ' set the level type
    dsoLevel.LevelType = levRegular
    ' "cusomter_state" column contains members for this level
    dsoLevel.MemberKeyColumn = sLQuote & "customer" & sRQuote & "." & _
                               sLQuote & "state_province" & sRQuote
    ' there are 10 distinct states in the "Customer" table
    dsoLevel.EstimatedSize = 10
    ' this level contains unique members,
    ' i.e. no state appears in more than one country
    dsoLevel.IsUnique = True
    ' DSO needs to know what is the type and maximum size of the members keys
    dsoLevel.ColumnType = adChar
    dsoLevel.ColumnSize = 9             ' the longest member ("Zacatecas")
                                        ' can fit in 9 characters
    ' we want the states ordered by Name
    dsoLevel.Ordering = orderName
    '
    ' create the Customer City level
    '   the Customer City level contains all of the cities
    On Error GoTo Err_Create
    Set dsoLevel = dsoDimension.Levels.AddNew("Customer City")
    ' set the level type
    dsoLevel.LevelType = levRegular
    ' "Customer_city" column contains members for this level
    dsoLevel.MemberKeyColumn = sLQuote & "customer" & sRQuote & "." & _
                               sLQuote & "city" & sRQuote
    ' there are 23 distinct cities in the "customer" table
    dsoLevel.EstimatedSize = 23
    ' this level contains unique members,
    ' i.e. no city appears in more than one state
    ' NOTE: this is often not the case,
    '       for example: Portland (Oregon) and Portland (Maine)
    dsoLevel.IsUnique = False
    ' DSO needs to know what is the type and maximum size of the members keys
    dsoLevel.ColumnType = adChar
    dsoLevel.ColumnSize = 13            ' the longest member ("San Francisco")
                                        ' can fit in 13 characters
    ' we want the cities ordered by Name
    dsoLevel.Ordering = orderName
    '
    ' create the customer Name level
    '   the customer Name level contains all of the individual stores
    On Error GoTo Err_Create
    Set dsoLevel = dsoDimension.Levels.AddNew("Customer Name")
    ' set the level type
    dsoLevel.LevelType = levRegular
    ' "customer_id" column contains members for this level
    dsoLevel.MemberKeyColumn = sLQuote & "customer" & sRQuote & "." & _
                               sLQuote & "customer_id" & sRQuote
    ' we will use column "fname lname" for member names
    dsoLevel.MemberNameColumn = sLQuote & "customer" & sRQuote & "." & _
                                sLQuote & "lname" & sRQuote
    ' there are 24 distinct stores in the "store" table
    dsoLevel.EstimatedSize = 24
    ' this level contains unique members,
    ' i.e. no customer appears in more than one city
    dsoLevel.IsUnique = False
    ' DSO needs to know what is the data type of the level members keys
    ' since this level has numeric member keys, we do not need to set the ColumnSize
    dsoLevel.ColumnType = adInteger
    'dsoLevel.ColumnSize = 20
    ' we want the stores ordered by Name
    dsoLevel.Ordering = orderName
    '
    ' create the member properties for the Store Name level
    '
    Dim dsoMemberProperty As DSO.MemberProperty
    ' save the dimension definition in the metadata repository
    On Error GoTo Err_Update
    dsoDimension.Update
    Debug.Print "Dimension Customer added to database."
Exit Sub
Err_Create:
    ' Failed to create the object.
    ' Possible reasons:
    '   - the DSO database object is being locked by another DSO application
    '       a DSO object is locked while AddNew method is executing on
    '       one of its collections (Datasources, MDStores, Dimensions...)
    '   - the metadata repository is unreachable
Err_Update:
    ' Failed to persist the dimension definition in the metadata repository
    ' Possible reasons:
    '   - the metadata repository is unreachable
    '       you can see where the metadata repository resides by looking
    '       up the following registry entry:
    '       HKEY_LOCAL_MACHINE\Software\Microsoft\OLAP Server\Server Connection Info
    '           Repository Connection String
    '   - the DSO dimension object is being locked by another DSO application
    '       it is not possible for two DSO apps to persist the same object
    '       at the same time
    '       it is not possible to persist a DSO object, it another DSO app
    '       has explicitly locked it
    MsgBox "Create dimension Store failed" & vbCrLf & Err.Description
End Sub
'   CreateDimensionProduct - create the Product dimension
'   NOTE: the Product dimension is an example of a snowflake dimension
'         (dimension based on multiple tables)
Public Sub CreateDimensionProduct()
    ' create the Product dimension in the database's
    ' Dimensions collection
    On Error GoTo Err_Create
    Dim dsoDimension As DSO.Dimension
    Set dsoDimension = m_dsoDatabase.Dimensions.AddNew("Product")
    ' set the dimension description
    dsoDimension.Description = "The Product hierarchy"
    ' set the dimension's datasource
    Set dsoDimension.DataSource = m_dsoDatabase.DataSources("Foodmart Sample Database")
    ' get the quoting characters from the datasource
    Dim sLQuote As String, sRQuote As String
    sLQuote = dsoDimension.DataSource.OpenQuoteChar
    sRQuote = dsoDimension.DataSource.CloseQuoteChar
    ' set the dimension type
    dsoDimension.DimensionType = dimRegular
    ' set the comma separeted list of the dimension tables
    ' NOTE: the tables must be quoted
    ' the Product dimension uses "product" and "product_class" tables
    dsoDimension.FromClause = sLQuote & "product" & sRQuote & _
                              ", " & _
                              sLQuote & "product_class" & sRQuote

    '
    ' create dimension levels
    '
    Dim dsoLevel As DSO.Level
    '
    ' create the Product Name level
    '   this level contains all of the brand names
    On Error GoTo Err_Create
    Set dsoLevel = dsoDimension.Levels.AddNew("Product Name")
    ' set the level type
    dsoLevel.LevelType = levRegular
    ' we will use the "product_name" column for member names
    dsoLevel.MemberKeyColumn = sLQuote & "product" & sRQuote & "." & _
                               sLQuote & "product_name" & sRQuote
    ' there are 1560 distinct products
    ' NOTE: you can use the following query to
    '       count the distinct members for this level
    '       SELECT DISTINCT product_class.product_family,
    '                       product_class.product_category,
    '                       product.brand_name,
    '                       product_id
    '       FROM product_class, product
    '       WHERE product_class.product_class_id = product.product_class_id
    '
    dsoLevel.EstimatedSize = 1560
    ' this level contains unique members
    dsoLevel.IsUnique = True
    ' DSO needs to know what is the type and maximum size of the members keys
    dsoLevel.ColumnType = adWChar
    ' we want the brands ordered by name
    dsoLevel.Ordering = orderName
    On Error GoTo Err_Update
    dsoDimension.Update
    Debug.Print "Dimension Product added to database."
Exit Sub
Err_Create:
    ' Failed to create the object.
    ' Possible reasons:
    '   - the DSO database object is being locked by another DSO application
    '       a DSO object is locked while AddNew method is executing on
    '       one of its collections (Datasources, MDStores, Dimensions...)
    '   - the metadata repository is unreachable
Err_Update:
    ' Failed to persist the dimension definition in the metadata repository
    ' Possible reasons:
    '   - the metadata repository is unreachable
    '       you can see where the metadata repository resides by looking
    '       up the following registry entry:
    '       HKEY_LOCAL_MACHINE\Software\Microsoft\OLAP Server\Server Connection Info
    '           Repository Connection String
    '   - the DSO dimension object is being locked by another DSO application
    '       it is not possible for two DSO apps to persist the same object
    '       at the same time
    '       it is not possible to persist a DSO object, it another DSO app
    '       has explicitly locked it
    MsgBox "Create dimension Product failed" & vbCrLf & Err.Description
End Sub
'   CreateCube - create the Sales cube
Public Sub CreateCube()
    ' create the Sales cube in the database's
    ' MDStores collection
    On Error GoTo Err_Create
    Dim dsoCube As DSO.MDStore
    Dim strCubeName As String
    Set dsoCube = m_dsoDatabase.MDStores.AddNew("small")
    ' set the cube's description
    dsoCube.Description = "The Sales cube"
    ' set the cube's datasource
    ' use the datasource that was created in the database's Datasources collection
    dsoCube.DataSources.Add m_dsoDatabase.DataSources("Foodmart Sample Database")
    ' get the quoting characters from the datasource
    Dim sLQuote As String, sRQuote As String
    sLQuote = dsoCube.DataSources(1).OpenQuoteChar
    sRQuote = dsoCube.DataSources(1).CloseQuoteChar
    ' set the source table (fact table) for the cube
    dsoCube.SourceTable = sLQuote & "sales_fact_1998" & sRQuote
    ' set the number of rows from the fact table that will be included in the cube
    ' since we want the whole table (we did not specify anything for SourceTableFilter)
    '   we can obtain this number by doing SELECT COUNT(*) FROM sales_fact_1998
    dsoCube.EstimatedRows = 164558
    '
    ' create cube's measures
    '
    Dim dsoMeasure As DSO.Measure
    ' create a measure for customer Sales
    Set dsoMeasure = dsoCube.Measures.AddNew("Store Sales")
    ' set the measure's source column, data type and the formatting
    dsoMeasure.SourceColumn = dsoCube.SourceTable & "." & _
                              sLQuote & "store_sales" & sRQuote
    dsoMeasure.SourceColumnType = adDouble
    dsoMeasure.FormatString = "Currency"
    ' this measure will be aggregated by summation
    dsoMeasure.AggregateFunction = aggSum

    '
    '   add dimensions to the cube
    '
    ' add the Product dimension
    ' note that by adding the dimension to the cube
    '   all of the dimension levels are automatically inherited from
    '   the corresponding database dimension
    Dim dsoProductCubeDim As DSO.Dimension
    Set dsoProductCubeDim = dsoCube.Dimensions.AddNew("product")
    ' add the Store dimension
    Dim dsoCustomerCubeDim As DSO.Dimension
    Set dsoCustomerCubeDim = dsoCube.Dimensions.AddNew("customer")
    ' get the list of all tables used in this cube
    ' this list includes the fact table and the dimension tables
    dsoCube.FromClause = dsoCube.SourceTable & ", " & _
                         dsoCustomerCubeDim.FromClause & ", " & _
                         dsoProductCubeDim.FromClause
    Debug.Print "Cube FromClause =" & dsoCube.FromClause
    ' define the joins between tables used by the cube
    ' first define the join between the fact table and the Store table
    dsoCube.JoinClause = _
            "(" & _
                sLQuote & "sales_fact_1998" & sRQuote & "." & sLQuote & "customer_id" & sRQuote & _
                " = " & _
                sLQuote & "customer" & sRQuote & "." & sLQuote & "customer_id" & sRQuote & _
            ")"
    ' define the join between the fact table and the Product table
    dsoCube.JoinClause = dsoCube.JoinClause & " AND " & _
            "(" & _
               sLQuote & "sales_fact_1998" & sRQuote & "." & sLQuote & "product_id" & sRQuote & _
               " = " & _
               sLQuote & "product" & sRQuote & "." & sLQuote & "product_id" & sRQuote & _
            ")"
    Debug.Print "Cube JoinClause =" & dsoCube.JoinClause
    ' save the cube definition in the metadata repository
    On Error GoTo Err_Update
    dsoCube.Update
    ' store the reference to the cube object
    ' so that other methods can use it
    Set m_dsoCube = dsoCube
Exit Sub
Err_Create:
    ' Failed to create the object.
    ' Possible reasons:
    '   - the DSO database object is being locked by another DSO application
    '       a DSO object is locked while AddNew method is executing on
    '       one of its collections (Datasources, MDStores, Dimensions...)
    '   - the metadata repository is unreachable
Err_Update:
    ' Failed to persist the cube definition in the metadata repository
    ' Possible reasons:
    '   - the metadata repository is unreachable
    '       you can see where the metadata repository resides by looking
    '       up the following registry entry:
    '       HKEY_LOCAL_MACHINE\Software\Microsoft\OLAP Server\Server Connection Info
    '           Repository Connection String
    '   - the DSO cube object is being locked by another DSO application
    '       it is not possible for two DSO apps to persist the same object
    '       at the same time
    '       it is not possible to persist a DSO object, it another DSO app
    '       has explicitly locked it
    MsgBox "Create cube Sales failed" & vbCrLf & Err.Description & vbCrLf & Err.Source
End Sub
'   ProcessDatabase - processes the whole DSO database
Public Sub ProcessDatabase()
    On Error GoTo Err_Process
    m_dsoDatabase.Process
Exit Sub
Err_Process:
    ' Processing of the database failes.
    ' Possible reasons:
    '   - OLAP server is not running or unreachable
    '   - connection to the relational data source cannot be established
    '   - cube or dimensions are not properly defined
    '   - another app is processing one of the cubes or dimensions from this
    '     database
    '   - another app has locked one of the cubes or dimensions from this
    '     database
    MsgBox "Design aggregations for Partition failed" & vbCrLf & Err.Description
End Sub
'   WriteEnableCube - enables the Sales cube for write back
'   Enabling a cube for writeback entails creation of a writeback partition.  Writeback
'   partition is a ROLAP partition without any aggregations.  The source table of the
'   writeback partition is called writeback table.  The writeback information is stored
'   in this table.
'   We will create the writeback table in the Foodmart sample database
Public Sub WriteEnableCube()
    ' get the cube's datasource
    Dim dsoDatasource As DSO.DataSource
    Set dsoDatasource = m_dsoCube.DataSources(1)
    ' make sure that we are still connected
    If dsoDatasource.IsConnected = False Then
        MsgBox "Cannot create write enable cube. Connection to the datasource cannot be established."
        Exit Sub
    End If
    ' what will be the writeback table name
    Dim sWriteBackTableName As String
    sWriteBackTableName = "Sample_Writeback_Sales"
    ' get the connection to the datasource
    Dim adoConnection As ADODB.Connection
    Set adoConnection = dsoDatasource.Connection
    ' create the writeback partition
    Dim dsoWBPartition As DSO.MDStore
    Set dsoWBPartition = m_dsoCube.MDStores.AddNew("Writeback")
    ' set the writeback flag
    dsoWBPartition.IsReadWrite = True
    ' set the partition's source table
    dsoWBPartition.SourceTable = dsoDatasource.OpenQuoteChar & sWriteBackTableName & dsoDatasource.CloseQuoteChar
    ' set the partition's storage mode
    ' NOTE: the writeback partition should not have any aggregations
    dsoWBPartition.OlapMode = olapmodeRolap
    ' begin transaction on the datasource connection
    adoConnection.BeginTrans
    ' create the writeback table
    ' and map the partition levels and measures to this table
    On Error GoTo Err_CreateWriteBackTable
    CreateWriteBackTable dsoWBPartition, dsoDatasource, adoConnection, sWriteBackTableName
    ' commit the transaction on the datasource
    ' NOTE: the OLAP server uses a different connection to the
    '       relational database, so we need to commit the
    '       changes here
    adoConnection.CommitTrans
    ' save the writeback partition
    dsoWBPartition.Update
    ' process the write back partition
    On Error GoTo Err_Process
    dsoWBPartition.Process processFull
Exit Sub
Err_CreateWriteBackTable:
    ' rollback transaction on the datasource
    adoConnection.RollbackTrans
    ' remove the writeback partition from the cube
    m_dsoCube.MDStores.Remove dsoWBPartition.Name
    MsgBox "Cannot create writeback table. " & Err.Description
    Exit Sub
Err_Process:
    ' remove the writeback table
    adoConnection.Execute "DROP TABLE " & sWriteBackTableName
    ' remove the writeback partition from the cube
    m_dsoCube.MDStores.Remove dsoWBPartition.Name
    MsgBox "Cannot process the writeback partition. " & Err.Description
    Exit Sub
End Sub
'   CreateWriteBackTable - create the writeback table
'   The writeback table must have one column for each measure
'   and level in the cube.  It also has two columns used by
'   the OLAP server for storing auditing information
'   This function creates the table and maps the writeback
'   partition levels and measures to this table
Private Sub CreateWriteBackTable(dsoWBPartition As DSO.MDStore, _
                                 dsoDatasource As DSO.DataSource, _
                                 adoConnection As ADODB.Connection, _
                                 TableName As String)
    ' drop the table if it already exists
    On Error Resume Next
    adoConnection.Execute "DROP TABLE " & TableName
    Err.Clear
    On Error GoTo 0
    ' construct the create table statement
    Dim sCreateTable As String
    sCreateTable = "CREATE TABLE " & TableName & " "
    sCreateTable = sCreateTable & " ( "
    ' create two columns required by the OLAP server
    ' for storing auditing information
    sCreateTable = sCreateTable & _
                    "MS_AUDIT_USER varchar(32), " & _
                    "MS_AUDIT_TIME  DateTime"
    ' create a column for each level
    ' since the column names have to be unique
    '   add the level OrdinalPosition to the level name
    Dim dsoPartDimension As DSO.Dimension
    Dim dsoPartLevel As DSO.Level
    Dim sColumnName As String
    For Each dsoPartDimension In dsoWBPartition.Dimensions
        For Each dsoPartLevel In dsoPartDimension.Levels
            If Not dsoPartLevel.LevelType = levAll And _
               Not dsoPartLevel.IsDisabled And _
               Not dsoPartLevel.SubClassType = sbclsVirtual Then
                ' get the column name
                sColumnName = GetColumnName(dsoPartLevel.Name & "_L" & CStr(dsoPartLevel.OrdinalPosition))
                ' update the create table statement
                sCreateTable = sCreateTable & ", " & _
                               sColumnName & " " & GetColumnTypeDefinition(dsoPartLevel.ColumnType, dsoPartLevel.ColumnSize)

                ' map the partition level to this column
                dsoPartLevel.MemberKeyColumn = dsoWBPartition.SourceTable & _
                                               "." & _
                                               dsoDatasource.OpenQuoteChar & sColumnName & dsoDatasource.CloseQuoteChar
            End If
        Next
    Next
    ' create a column for each measure
    ' and map the partition measure to this column
    Dim dsoPartitionMeasure As DSO.Measure
    For Each dsoPartitionMeasure In dsoWBPartition.Measures
        ' get the column name
        sColumnName = GetColumnName(dsoPartitionMeasure.Name)
        ' update the create table statement
        sCreateTable = sCreateTable & ", " & _
                       sColumnName & " " & GetColumnTypeDefinition(dsoPartitionMeasure.SourceColumnType)
        ' map the partition measure to this column
        dsoPartitionMeasure.SourceColumn = dsoWBPartition.SourceTable & _
                                           "." & _
                                           dsoDatasource.OpenQuoteChar & sColumnName & dsoDatasource.CloseQuoteChar
    Next
    ' complete the create table statement
    sCreateTable = sCreateTable & ")"
    ' execute the create table statement
    adoConnection.Execute sCreateTable
End Sub
'   GetColumnTypeDefinition - return a string describing the data type
'                             that can be used in create table statement
'   NOTE: this function works with Jet provider, other providers have different data type names
Private Function GetColumnTypeDefinition(ColumnType As ADODB.DataTypeEnum, Optional ColumnSize As Integer = 50) As String
    Select Case ColumnType
        Case adChar, adVarChar, adWChar
            GetColumnTypeDefinition = " VARCHAR (" & CStr(ColumnSize) & ") "
        Case adCurrency
            GetColumnTypeDefinition = " CURRENCY "
        Case adInteger
            GetColumnTypeDefinition = " INTEGER "
        Case adSmallInt
            GetColumnTypeDefinition = " SMALLINT "
        Case adSingle
            GetColumnTypeDefinition = " REAL "
        Case adDouble
            GetColumnTypeDefinition = " DOUBLE "
        Case adDBTimeStamp, adDate
            GetColumnTypeDefinition = " DATETIME "
        Case Else
            Debug.Assert False ' there is a new data type
                               ' we need to update this function
    End Select
End Function
'   GetColumnName   - create a column name based on the given string
'                     get rid of spaces
Private Function GetColumnName(ObjectName As String) As String
    Dim s As String
    Dim c As String
    Dim i As Integer
    For i = Len(ObjectName) To 1 Step -1
        c = Mid(ObjectName, i, 1)
        If c <> " " Then
            ' legal char, use it
            s = c + s
        End If
    Next
    GetColumnName = s
End Function