LISTING 4: Option Explicit

Const sGUID_SCHEMA_SERVICE_PARAMETERS As String = "{3ADD8A75-D8B9-11D2-8D2A-00E029154FDE}"
Const sGUID_SCHEMA_MINING_SERVICES    As String = "{3ADD8A95-D8B9-11D2-8D2A-00E029154FDE}"
Const sGUID_SCHEMA_MINING_MODELS      As String = "{3ADD8A77-D8B9-11D2-8D2A-00E029154FDE}"
Const sGUID_SCHEMA_MINING_COLUMNS     As String = "{3ADD8A78-D8B9-11D2-8D2A-00E029154FDE}"
Const sGUID_SCHEMA_MODEL_CONTENT      As String = "{3ADD8A76-D8B9-11D2-8D2A-00E029154FDE}"
Const sGUID_SCHEMA_MODEL_CONTENT_PMML As String = "{4290B2D5-0E9C-4AA7-9369-98C95CFD9D13}"

Dim m_conn As New ADODB.Connection

Private Sub ExecuteMDX(ByVal v_sMDX As String)
    On Error GoTo ErrHandler
   
    Dim cmd As New ADODB.Command
    Dim rec As Recordset
    Dim nNum As Integer
   
    Set cmd.ActiveConnection = m_conn
    cmd.CommandText = v_sMDX
    Set rec = cmd.Execute(nNum)
   
    MsgBox "Command Executed Successfully. " & nNum & " rows affected.", vbOKOnly + vbInformation
    Exit Sub
   
ErrHandler:
    MsgBox Err.Description, vbExclamation
End Sub

Private Sub Form_Load()
    ' Specify .2 on the provider so only SQL 2000 will work
    ' Connect to a server on the local PC.  Change this if you are connecting
    ' to another PC with Analysis Services.
    Call m_conn.Open("PROVIDER=MSOLAP.2;Data Source=LOCALHOST;")

    ' Create the mining model
    Call ExecuteMDX( _
      "CREATE OLAP MINING MODEL [Local Find Salary] " & _
      "From [Sales] " & _
      "( " & _
      "   CASE " & _
      "      Dimension [Customers] " & _
      "      Level [Name] " & _
      "         PROPERTY [Gender] ," & _
      "         PROPERTY [Marital Status] ," & _
      "         PROPERTY [Education] ," & _
      "         PROPERTY [Yearly Income] PREDICT " & _
      ")" & _
      "USING Microsoft_Decision_Trees")
   
    ' Fill the mining model
    Call ExecuteMDX("INSERT INTO [Local Find Salary]")
   
    ' Create a virtual cube based on the mining model
    Call ExecuteMDX( _
      "CREATE SESSION VIRTUAL CUBE [PredictIncomeCube] " & _
      "FROM [Sales] " & _
      "( " & _
      "    MEASURE [Sales].[Unit Sales] , " & _
      "    DIMENSION [Sales].[Customers], " & _
      "    DIMENSION [Sales].[Time], " & _
      "    DIMENSION [PredictIncome] NOT_RELATED_TO_FACTS " & _
      "      FROM [Local Find Salary] " & _
      "      COLUMN [Customers.Name.Yearly Income] " & _
      ") ")
     
    Dim recCols As Recordset
    Dim vtRestrict As Variant
   
    vtRestrict = Array(Empty, Empty, "Local Find Salary")
     
    ' open the data mining model's content as a rowset
    Set recCols = m_conn.OpenSchema(adSchemaProviderSpecific, vtRestrict, _
            sGUID_SCHEMA_MODEL_CONTENT)
   
    ' display each node caption of the resulting decision tree
    Do While Not recCols.EOF
        MsgBox recCols.Fields("NODE_CAPTION").Value
        recCols.MoveNext
    Loop
   
    m_conn.Close
End Sub