Attribute VB_Name = "modCreateCube"
Option Explicit

Public Sub Main()
On Error GoTo ProcErr

Dim adocon As New ADODB.Connection
Dim sConnection As String
Dim sLocation As String
Dim sSourceDSN As String
Dim sCreateCube As String
Dim sInsertInto As String

sCreateCube = ""

sLocation = "LOCATION= C:\Temp\LocalCube.cub"

sSourceDSN = "SOURCE_DSN = ""Provider=MSOLAP;data source=LocalHost;INITIAL CATALOG=FoodMart 2000"""

sCreateCube = ""
sCreateCube = sCreateCube & "CREATECUBE=CREATE CUBE LocalCube " & vbCrLf
sCreateCube = sCreateCube & "  (" & vbCrLf
sCreateCube = sCreateCube & "  DIMENSION [Customers]," & vbCrLf
sCreateCube = sCreateCube & "      LEVEL [All Customers] TYPE ALL," & vbCrLf
sCreateCube = sCreateCube & "      LEVEL [Country] OPTIONS(SORTBYNAME)," & vbCrLf
sCreateCube = sCreateCube & "      LEVEL [State Province] OPTIONS(SORTBYNAME)," & vbCrLf
sCreateCube = sCreateCube & "  DIMENSION [Product]," & vbCrLf
sCreateCube = sCreateCube & "      LEVEL [All Product] TYPE ALL," & vbCrLf
sCreateCube = sCreateCube & "      LEVEL [Product Family] OPTIONS(SORTBYNAME)," & vbCrLf
sCreateCube = sCreateCube & "      LEVEL [Product Department] OPTIONS(SORTBYNAME)," & vbCrLf
sCreateCube = sCreateCube & "      LEVEL [Product Category] OPTIONS(SORTBYNAME)," & vbCrLf
sCreateCube = sCreateCube & "      LEVEL [Product Subcategory] OPTIONS(SORTBYNAME)," & vbCrLf
sCreateCube = sCreateCube & "  DIMENSION [Store]," & vbCrLf
sCreateCube = sCreateCube & "      LEVEL [All Store] TYPE ALL," & vbCrLf
sCreateCube = sCreateCube & "      LEVEL [Store Country] OPTIONS(SORTBYNAME)," & vbCrLf
sCreateCube = sCreateCube & "      LEVEL [Store State] OPTIONS(SORTBYNAME)," & vbCrLf
sCreateCube = sCreateCube & "      LEVEL [Store City] OPTIONS(SORTBYNAME)," & vbCrLf
sCreateCube = sCreateCube & "      LEVEL [Store Name] OPTIONS(SORTBYPROPERTY [Store Sqft])," & vbCrLf
sCreateCube = sCreateCube & "        PROPERTY [Store Sqft] TYPE REGULAR CAPTION ""Store Sqft""," & vbCrLf
sCreateCube = sCreateCube & "        PROPERTY [Store Manager] TYPE Person_Full_Name CAPTION ""Manager""," & vbCrLf
sCreateCube = sCreateCube & "        PROPERTY [Store Type] TYPE Regular CAPTION ""Store Type""," & vbCrLf
sCreateCube = sCreateCube & "  DIMENSION [Time] TYPE TIME," & vbCrLf
sCreateCube = sCreateCube & "      LEVEL [All Time] TYPE ALL," & vbCrLf
sCreateCube = sCreateCube & "      LEVEL [Year] TYPE YEAR OPTIONS(SORTBYNAME)," & vbCrLf
sCreateCube = sCreateCube & "      LEVEL [Month] TYPE MONTH OPTIONS(SORTBYKEY)," & vbCrLf
sCreateCube = sCreateCube & "  DIMENSION [Yearly Income]," & vbCrLf
sCreateCube = sCreateCube & "      LEVEL [All Yearly Income] TYPE ALL," & vbCrLf
sCreateCube = sCreateCube & "      LEVEL [Yearly Income] OPTIONS(SORTBYNAME)," & vbCrLf
sCreateCube = sCreateCube & "  MEASURE [Sales Count] Function COUNT FORMAT '#' TYPE DBTYPE_I8," & vbCrLf
sCreateCube = sCreateCube & "  MEASURE [Store Cost] Function SUM FORMAT 'Standard' TYPE DBTYPE_R8," & vbCrLf
sCreateCube = sCreateCube & "  MEASURE [Store Sales] Function SUM FORMAT 'Standard' TYPE DBTYPE_R8," & vbCrLf
sCreateCube = sCreateCube & "  MEASURE [Store Sales Net] Function SUM FORMAT 'Standard' TYPE DBTYPE_R8," & vbCrLf
sCreateCube = sCreateCube & "  MEASURE [Unit Sales] Function SUM FORMAT 'Standard' TYPE DBTYPE_R8," & vbCrLf
sCreateCube = sCreateCube & "  COMMAND (CREATE MEMBER LocalCube.Measures.[Profit]" & vbCrLf
sCreateCube = sCreateCube & "     AS '[Measures].[Store Sales]-[Measures].[Store Cost]', " & vbCrLf
sCreateCube = sCreateCube & "       FORMAT_STRING = 'Standard')," & vbCrLf
sCreateCube = sCreateCube & "  COMMAND (CREATE MEMBER LocalCube.Measures.[Sales Average]" & vbCrLf
sCreateCube = sCreateCube & "     AS '[Measures].[Store Sales]/[Measures].[Sales Count]', " & vbCrLf
sCreateCube = sCreateCube & "       FORMAT_STRING = 'Standard')" & vbCrLf
sCreateCube = sCreateCube & "  )"

sInsertInto = ""
sInsertInto = sInsertInto & "INSERTINTO=INSERT INTO LocalCube" & vbCrLf
sInsertInto = sInsertInto & "  (" & vbCrLf
sInsertInto = sInsertInto & "  [Customers].[Country].NAME," & vbCrLf
sInsertInto = sInsertInto & "  [Customers].[Country].KEY," & vbCrLf
sInsertInto = sInsertInto & "  [Customers].[State Province].NAME," & vbCrLf
sInsertInto = sInsertInto & "  [Customers].[State Province].KEY," & vbCrLf

sInsertInto = sInsertInto & "  [Product].[Product Family].NAME," & vbCrLf
sInsertInto = sInsertInto & "  [Product].[Product Family].KEY," & vbCrLf
sInsertInto = sInsertInto & "  [Product].[Product Department].NAME," & vbCrLf
sInsertInto = sInsertInto & "  [Product].[Product Department].KEY," & vbCrLf
sInsertInto = sInsertInto & "  [Product].[Product Category].NAME," & vbCrLf
sInsertInto = sInsertInto & "  [Product].[Product Category].KEY," & vbCrLf
sInsertInto = sInsertInto & "  [Product].[Product Subcategory].NAME," & vbCrLf
sInsertInto = sInsertInto & "  [Product].[Product Subcategory].KEY," & vbCrLf

sInsertInto = sInsertInto & "  [Store].[Store Country].NAME," & vbCrLf
sInsertInto = sInsertInto & "  [Store].[Store Country].KEY," & vbCrLf
sInsertInto = sInsertInto & "  [Store].[Store State].NAME," & vbCrLf
sInsertInto = sInsertInto & "  [Store].[Store State].KEY," & vbCrLf
sInsertInto = sInsertInto & "  [Store].[Store City].NAME," & vbCrLf
sInsertInto = sInsertInto & "  [Store].[Store City].KEY," & vbCrLf
sInsertInto = sInsertInto & "  [Store].[Store Name].NAME," & vbCrLf
sInsertInto = sInsertInto & "  [Store].[Store Name].[Store Sqft]," & vbCrLf
sInsertInto = sInsertInto & "  [Store].[Store Name].[Store Manager]," & vbCrLf
sInsertInto = sInsertInto & "  [Store].[Store Name].[Store Type]," & vbCrLf

sInsertInto = sInsertInto & "  [Time].[Year].NAME," & vbCrLf
sInsertInto = sInsertInto & "  [Time].[Year].KEY," & vbCrLf
sInsertInto = sInsertInto & "  [Time].[Month].NAME," & vbCrLf
sInsertInto = sInsertInto & "  [Time].[Month].KEY," & vbCrLf

sInsertInto = sInsertInto & "  [Yearly Income].[Yearly Income].NAME," & vbCrLf
sInsertInto = sInsertInto & "  [Yearly Income].[Yearly Income].KEY," & vbCrLf

sInsertInto = sInsertInto & "  [Measures].[Sales Count]," & vbCrLf
sInsertInto = sInsertInto & "  [Measures].[Store Cost]," & vbCrLf
sInsertInto = sInsertInto & "  [Measures].[Store Sales]," & vbCrLf
sInsertInto = sInsertInto & "  [Measures].[Store Sales Net]," & vbCrLf
sInsertInto = sInsertInto & "  [Measures].[Unit Sales]" & vbCrLf
sInsertInto = sInsertInto & "  )" & vbCrLf

sInsertInto = sInsertInto & "SELECT" & vbCrLf

sInsertInto = sInsertInto & "  [Sales].[Customers:Country]," & vbCrLf
sInsertInto = sInsertInto & "  [Sales].[Customers:Country!KEY]," & vbCrLf
sInsertInto = sInsertInto & "  [Sales].[Customers:State Province]," & vbCrLf
sInsertInto = sInsertInto & "  [Sales].[Customers:State Province!KEY]," & vbCrLf

sInsertInto = sInsertInto & "  [Sales].[Product:Product Family]," & vbCrLf
sInsertInto = sInsertInto & "  [Sales].[Product:Product Family!KEY]," & vbCrLf
sInsertInto = sInsertInto & "  [Sales].[Product:Product Department]," & vbCrLf
sInsertInto = sInsertInto & "  [Sales].[Product:Product Department!KEY]," & vbCrLf
sInsertInto = sInsertInto & "  [Sales].[Product:Product Category]," & vbCrLf
sInsertInto = sInsertInto & "  [Sales].[Product:Product Category!KEY]," & vbCrLf
sInsertInto = sInsertInto & "  [Sales].[Product:Product Subcategory]," & vbCrLf
sInsertInto = sInsertInto & "  [Sales].[Product:Product Subcategory!KEY]," & vbCrLf

sInsertInto = sInsertInto & "  [Sales].[Store:Store Country]," & vbCrLf
sInsertInto = sInsertInto & "  [Sales].[Store:Store Country!KEY]," & vbCrLf
sInsertInto = sInsertInto & "  [Sales].[Store:Store State]," & vbCrLf
sInsertInto = sInsertInto & "  [Sales].[Store:Store State!KEY]," & vbCrLf
sInsertInto = sInsertInto & "  [Sales].[Store:Store City]," & vbCrLf
sInsertInto = sInsertInto & "  [Sales].[Store:Store City!KEY]," & vbCrLf
sInsertInto = sInsertInto & "  [Sales].[Store:Store Name]," & vbCrLf
sInsertInto = sInsertInto & "  [Sales].[Store:Store Name!Store Sqft]," & vbCrLf
sInsertInto = sInsertInto & "  [Sales].[Store:Store Name!Store Manager]," & vbCrLf
sInsertInto = sInsertInto & "  [Sales].[Store:Store Name!Store Type]," & vbCrLf

sInsertInto = sInsertInto & "  [Sales].[Time:Year]," & vbCrLf
sInsertInto = sInsertInto & "  [Sales].[Time:Year!KEY]," & vbCrLf
sInsertInto = sInsertInto & "  [Sales].[Time:Month]," & vbCrLf
sInsertInto = sInsertInto & "  [Sales].[Time:Month!KEY]," & vbCrLf

sInsertInto = sInsertInto & "  [Sales].[Yearly Income:Yearly Income]," & vbCrLf
sInsertInto = sInsertInto & "  [Sales].[Yearly Income:Yearly Income!KEY]," & vbCrLf

sInsertInto = sInsertInto & "  [Sales].[Measures:Sales Count]," & vbCrLf
sInsertInto = sInsertInto & "  [Sales].[Measures:Store Cost]," & vbCrLf
sInsertInto = sInsertInto & "  [Sales].[Measures:Store Sales]," & vbCrLf
sInsertInto = sInsertInto & "  [Sales].[Measures:Store Sales Net]," & vbCrLf
sInsertInto = sInsertInto & "  [Sales].[Measures:Unit Sales]" & vbCrLf

sInsertInto = sInsertInto & "From [Sales]" & vbCrLf

sInsertInto = sInsertInto & "WHERE (([Sales].[Product:Product Family] = '[Product].[All Products].[Drink]')" & vbCrLf
sInsertInto = sInsertInto & "     OR ([Sales].[Product:Product Family] = '[Product].[All Products].[Non-Consumable]'))" & vbCrLf
sInsertInto = sInsertInto & "AND (([Sales].[Customers:Country] = '[Customers].[All Customers].[Mexico]')" & vbCrLf
sInsertInto = sInsertInto & "    OR ([Sales].[Customers:Country] = '[Customers].[All Customers].[USA]'))" & vbCrLf

sConnection = sLocation & ";" & vbCrLf & sSourceDSN & ";" & vbCrLf & sCreateCube & ";" & vbCrLf & sInsertInto

adocon.ConnectionString = sConnection
adocon.Provider = "MSOLAP"

'Create the cube!
MsgBox "About to create the cube!"
Debug.Print sConnection
adocon.Open
MsgBox "Cube created!"

adocon.Close

ProcExit:
    Exit Sub

ProcErr:
  MsgBox Err.Number & vbCrLf & Err.Description
  Resume ProcExit

End Sub