home *** CD-ROM | disk | FTP | other *** search
/ io Programmo 32 / IOPROG_32.ISO / SOFT / SqlEval7 / MSOLAP / samples / Samples.exe / VbAdoCubeDoc / frmVBADOCubeDoc.frm (.txt) next >
Encoding:
Visual Basic Form  |  1998-10-30  |  22.7 KB  |  327 lines
  1. VERSION 5.00
  2. Begin VB.Form frmVBADOCubeDoc 
  3.    Caption         =   "Form1"
  4.    ClientHeight    =   3195
  5.    ClientLeft      =   60
  6.    ClientTop       =   345
  7.    ClientWidth     =   4680
  8.    LinkTopic       =   "Form1"
  9.    ScaleHeight     =   3195
  10.    ScaleWidth      =   4680
  11.    StartUpPosition =   3  'Windows Default
  12.    Begin VB.CommandButton cmdCreateDocForCube 
  13.       Caption         =   "Create Word 8.0 Document for cube file"
  14.       Height          =   915
  15.       Left            =   765
  16.       TabIndex        =   0
  17.       Top             =   1080
  18.       Width           =   3255
  19.    End
  20. Attribute VB_Name = "frmVBADOCubeDoc"
  21. Attribute VB_GlobalNameSpace = False
  22. Attribute VB_Creatable = False
  23. Attribute VB_PredeclaredId = True
  24. Attribute VB_Exposed = False
  25. Private Sub cmdCreateDocForCube_Click()
  26. Dim cn As ADODB.Connection
  27. Dim s As String
  28. Dim strProvider As String
  29. Dim strDataSource As String
  30. Dim strSourceDSN As String
  31. Dim strSourceDSNSuffix As String
  32. Dim strCreateCube As String
  33. Dim strInsertInto As String
  34. On Error GoTo Error_cmdCreateDocForCube_Click
  35. '*----------------------------------------------------------------------------------------------------------------------------------------
  36. '* The following code builds a cube file  then documents the properties with an OLE Connection
  37. '* to Word 8.0
  38. '*----------------------------------------------------------------------------------------------------------------------------------------
  39. '*----------------------------------------------------------------------------------------------------------------------------------------
  40. '* Add Provider, the name of the engine that will process the connection string.
  41. '*----------------------------------------------------------------------------------------------------------------------------------------
  42. strProvider = "PROVIDER=MSOLAP"
  43. '*----------------------------------------------------------------------------------------------------------------------------------------
  44. '* Add DataSource, the name of the file we will create.
  45. '*----------------------------------------------------------------------------------------------------------------------------------------
  46. strDataSource = "DATA SOURCE=c:\DocumentCube.cub"
  47. '*----------------------------------------------------------------------------------------------------------------------------------------
  48. '* Add Source DSN, the connection string for where the data comes from.
  49. '* We need to quote the value so it is parsed as one value.
  50. '* This can either be an ODBC connection string or an OLE DB connection string.
  51. '* (As returned by the Data Source Locator component.)
  52. '*       strSourceDSN = "SOURCE_DSN=DRIVER=Microsoft Access Driver (*.mdb);DBQ=\\platoue1\Samples\Sales.MDB;"
  53. '*----------------------------------------------------------------------------------------------------------------------------------------
  54. strSourceDSN = "SOURCE_DSN=FoodMart"
  55. '*----------------------------------------------------------------------------------------------------------------------------------------
  56. '* We may have some other parameters that we want applied at run time, but
  57. '* not stored in the cube file, or returned in the output string.
  58. '*----------------------------------------------------------------------------------------------------------------------------------------
  59. ' strSourceDSNSuffix = "UID=;PWD="
  60. '*----------------------------------------------------------------------------------------------------------------------------------------
  61. '* Add CREATE CUBE.  This defines the structure of the cube, but not the data in it.
  62. '* The BNF for this is somewhere in the documentation.
  63. '* Note that we can quote names with either double quotes or square brackets.
  64. '*----------------------------------------------------------------------------------------------------------------------------------------
  65. strCreateCube = "CREATECUBE=CREATE CUBE Sample( "
  66. strCreateCube = strCreateCube & "DIMENSION [Product],"
  67.         strCreateCube = strCreateCube & "LEVEL [All Products]  TYPE ALL,"
  68.         strCreateCube = strCreateCube & "LEVEL [Product Family] ,"
  69.         strCreateCube = strCreateCube & "LEVEL [Product Department] ,"
  70.         strCreateCube = strCreateCube & "LEVEL [Product Category] ,"
  71.         strCreateCube = strCreateCube & "LEVEL [Product Subcategory] ,"
  72.         strCreateCube = strCreateCube & "LEVEL [Brand Name] ,"
  73.         strCreateCube = strCreateCube & "LEVEL [Product Name] ,"
  74. strCreateCube = strCreateCube & "DIMENSION [Store],"
  75.         strCreateCube = strCreateCube & "LEVEL [All Stores]  TYPE ALL,"
  76.         strCreateCube = strCreateCube & "LEVEL [Store Country] ,"
  77.         strCreateCube = strCreateCube & "LEVEL [Store State] ,"
  78.         strCreateCube = strCreateCube & "LEVEL [Store City] ,"
  79.         strCreateCube = strCreateCube & "LEVEL [Store Name] ,"
  80. strCreateCube = strCreateCube & "DIMENSION [Store Type],"
  81.         strCreateCube = strCreateCube & "LEVEL [All Store Type]  TYPE ALL,"
  82.         strCreateCube = strCreateCube & "LEVEL [Store Type] ,"
  83. strCreateCube = strCreateCube & "DIMENSION [Time] TYPE TIME,"
  84.     strCreateCube = strCreateCube & "HIERARCHY [Column],"
  85.         strCreateCube = strCreateCube & "LEVEL [All Time]  TYPE ALL,"
  86.         strCreateCube = strCreateCube & "LEVEL [Year]  TYPE YEAR,"
  87.         strCreateCube = strCreateCube & "LEVEL [Quarter]  TYPE QUARTER,"
  88.         strCreateCube = strCreateCube & "LEVEL [Month]  TYPE MONTH,"
  89.         strCreateCube = strCreateCube & "LEVEL [Week]  TYPE WEEK,"
  90.         strCreateCube = strCreateCube & "LEVEL [Day]  TYPE DAY,"
  91.     strCreateCube = strCreateCube & "HIERARCHY [Formula],"
  92.         strCreateCube = strCreateCube & "LEVEL [All Formula Time]  TYPE ALL,"
  93.         strCreateCube = strCreateCube & "LEVEL [Year]  TYPE YEAR,"
  94.         strCreateCube = strCreateCube & "LEVEL [Quarter]  TYPE QUARTER,"
  95.         strCreateCube = strCreateCube & "LEVEL [Month]  TYPE MONTH OPTIONS (SORTBYKEY) ,"
  96. strCreateCube = strCreateCube & "DIMENSION [Warehouse],"
  97.         strCreateCube = strCreateCube & "LEVEL [All Warehouses]  TYPE ALL,"
  98.         strCreateCube = strCreateCube & "LEVEL [Country] ,"
  99.         strCreateCube = strCreateCube & "LEVEL [State Province] ,"
  100.         strCreateCube = strCreateCube & "LEVEL [City] ,"
  101.         strCreateCube = strCreateCube & "LEVEL [Warehouse Name] ,"
  102. strCreateCube = strCreateCube & "MEASURE [Store Invoice] "
  103.     strCreateCube = strCreateCube & "Function Sum "
  104.     strCreateCube = strCreateCube & "Format '#.#',"
  105. strCreateCube = strCreateCube & "MEASURE [Supply Time] "
  106.     strCreateCube = strCreateCube & "Function Sum "
  107.     strCreateCube = strCreateCube & "Format '#.#',"
  108. strCreateCube = strCreateCube & "MEASURE [Warehouse Cost] "
  109.     strCreateCube = strCreateCube & "Function Sum "
  110.     strCreateCube = strCreateCube & "Format '#.#',"
  111. strCreateCube = strCreateCube & "MEASURE [Warehouse Sales] "
  112.     strCreateCube = strCreateCube & "Function Sum "
  113.     strCreateCube = strCreateCube & "Format '#.#',"
  114. strCreateCube = strCreateCube & "MEASURE [Units Shipped] "
  115.     strCreateCube = strCreateCube & "Function Sum "
  116.     strCreateCube = strCreateCube & "Format '#.#',"
  117. strCreateCube = strCreateCube & "MEASURE [Units Ordered] "
  118.     strCreateCube = strCreateCube & "Function Sum "
  119.     strCreateCube = strCreateCube & "Format '#.#')"
  120. '*----------------------------------------------------------------------------------------------------------------------------------------
  121. '*Add INSERT INTO.  This defines where the data comes from, and how it maps
  122. '* into the already-defined cube structure.
  123. '* Note that the SELECT clause might just be passed through to the relational database.
  124. '* So I could pass in a stored procedure, for example.
  125. '* If we needed to, we could quote this whole thing.
  126. '* Note that the columns in the SELECT can be in any order.  One merely has to
  127. '* adjust the ordering of the list of level/measure names to match the SELECT ordering.
  128. '*----------------------------------------------------------------------------------------------------------------------------------------
  129. strInsertInto = strInsertInto & "INSERTINTO=INSERT INTO Sample( Product.[Product Family], Product.[Product Department],"
  130. strInsertInto = strInsertInto & "Product.[Product Category], Product.[Product Subcategory],"
  131. strInsertInto = strInsertInto & "Product.[Brand Name], Product.[Product Name],"
  132. strInsertInto = strInsertInto & "Store.[Store Country], Store.[Store State], Store.[Store City],"
  133. strInsertInto = strInsertInto & "Store.[Store Name], [Store Type].[Store Type], [Time].[Column],"
  134. strInsertInto = strInsertInto & "[Time].Formula.Year, [Time].Formula.Quarter, [Time].Formula.Month.[Key],"
  135. strInsertInto = strInsertInto & "[Time].Formula.Month.Name, Warehouse.Country, Warehouse.[State Province],"
  136. strInsertInto = strInsertInto & "Warehouse.City, Warehouse.[Warehouse Name], Measures.[Store Invoice],"
  137. strInsertInto = strInsertInto & "Measures.[Supply Time], Measures.[Warehouse Cost], Measures.[Warehouse Sales],"
  138. strInsertInto = strInsertInto & "Measures.[Units Shipped], Measures.[Units Ordered] )"
  139. '*----------------------------------------------------------------------------------------------------------------------------------------
  140. '* Add some options to the INSERT INTO if we need to.
  141. '* These can control if the SELECT clause is analyzed or just passed through,
  142. '* and if the storage mode is MOLAP or ROLAP (DEFER_DATA).
  143. '* strInsertInto = strInsertInto & " OPTIONS ATTEMPT_ANALYSIS"
  144. '*----------------------------------------------------------------------------------------------------------------------------------------
  145. '*----------------------------------------------------------------------------------------------------------------------------------------
  146. '* Add the SELECT clause of the INSERT INTO statement.
  147. '* Note that it is merely concatenated onto the end of the INSERT INTO statement.
  148. '* OLAP Services will pass this through to the source database if unable to parse it.
  149. '* Note that for OLAP Services to analyze the SELECT clause, each column must be
  150. '* qualified with the table name.
  151. '*----------------------------------------------------------------------------------------------------------------------------------------
  152. strInsertInto = strInsertInto & "SELECT product_class.product_family AS Col1,"
  153. strInsertInto = strInsertInto & "product_class.product_department AS Col2,"
  154. strInsertInto = strInsertInto & "product_class.product_category AS Col3,"
  155. strInsertInto = strInsertInto & "product_class.product_subcategory AS Col4,"
  156. strInsertInto = strInsertInto & "product.brand_name AS Col5,"
  157. strInsertInto = strInsertInto & "product.product_name AS Col6,"
  158. strInsertInto = strInsertInto & "store.store_country AS Col7,"
  159. strInsertInto = strInsertInto & "store.store_state AS Col8,"
  160. strInsertInto = strInsertInto & "store.store_city AS Col9,"
  161. strInsertInto = strInsertInto & "store.store_name AS Col10,"
  162. strInsertInto = strInsertInto & "store.store_type AS Col11,"
  163. strInsertInto = strInsertInto & "time_by_day.the_date AS Col12,"
  164. strInsertInto = strInsertInto & "time_by_day.the_year AS Col13,"
  165. strInsertInto = strInsertInto & "time_by_day.quarter AS Col14,"
  166. strInsertInto = strInsertInto & "time_by_day.month_of_year AS Col15,"
  167. strInsertInto = strInsertInto & "time_by_day.the_month AS Col16,"
  168. strInsertInto = strInsertInto & "warehouse.warehouse_country AS Col17,"
  169. strInsertInto = strInsertInto & "warehouse.warehouse_state_province AS Col18,"
  170. strInsertInto = strInsertInto & "warehouse.warehouse_city AS Col19,"
  171. strInsertInto = strInsertInto & "warehouse.warehouse_name AS Col20,"
  172. strInsertInto = strInsertInto & "inventory_fact_1997.store_invoice AS Col21,"
  173. strInsertInto = strInsertInto & "inventory_fact_1997.supply_time AS Col22,"
  174. strInsertInto = strInsertInto & "inventory_fact_1997.warehouse_cost AS Col23,"
  175. strInsertInto = strInsertInto & "inventory_fact_1997.warehouse_sales AS Col24,"
  176. strInsertInto = strInsertInto & "inventory_fact_1997.units_shipped AS Col25,"
  177. strInsertInto = strInsertInto & "inventory_fact_1997.units_ordered AS Col26 "
  178. strInsertInto = strInsertInto & "From [inventory_fact_1997], [product], [product_class], [time_by_day], [store], [warehouse] "
  179. strInsertInto = strInsertInto & "Where [inventory_fact_1997].[product_id] = [product].[product_id] And "
  180. strInsertInto = strInsertInto & "[product].[product_class_id] = [product_class].[product_class_id] And "
  181. strInsertInto = strInsertInto & "[inventory_fact_1997].[time_id] = [time_by_day].[time_id] And "
  182. strInsertInto = strInsertInto & "[inventory_fact_1997].[store_id] = [store].[store_id] And "
  183. strInsertInto = strInsertInto & "[inventory_fact_1997].[warehouse_id] = [warehouse].[warehouse_id]"
  184. '*----------------------------------------------------------------------------------------------------------------------------------------
  185. '* Create the cube by passing connection string to Open.
  186. '*----------------------------------------------------------------------------------------------------------------------------------------
  187. Set cn = New ADODB.Connection
  188. s = strProvider & ";" & strDataSource & ";" & strSourceDSN & ";" & strCreateCube & ";" & strInsertInto & ";"
  189. Screen.MousePointer = vbHourglass
  190. cn.Open s
  191. '*----------------------------------------------------------------------------------------------------------------------------------------
  192. '* Cube file is written to hard drive a Word Document can be produced by automating Word with VB
  193. '*----------------------------------------------------------------------------------------------------------------------------------------
  194. Dim cat As New ADOMD.Catalog
  195. Dim cdf As ADOMD.CubeDef
  196. Dim di As Integer
  197. Dim hi As Integer
  198. Dim le As Integer
  199. Dim mem As Integer
  200. Dim docWord As Word.Document
  201. Dim rngCurrent As Word.Range
  202. Dim SenCount As Integer
  203. Dim strServer As String
  204. Dim strSource As String
  205. Dim strCubeName As String
  206. '*----------------------------------------------------------------------------------------------------------------------------------------
  207. '* Connection is made to cube file
  208. '*----------------------------------------------------------------------------------------------------------------------------------------
  209. cat.ActiveConnection = "DATA SOURCE=c:\DocumentCube.cub;Provider=msolap;"
  210. '*----------------------------------------------------------------------------------------------------------------------------------------
  211. '* Cube Definition is set to Name of Cube in cube file
  212. '*----------------------------------------------------------------------------------------------------------------------------------------
  213. Set cdf = cat.CubeDefs("Sample")
  214. '*----------------------------------------------------------------------------------------------------------------------------------------
  215. '* Object is created to hold Word 8.0
  216. '*----------------------------------------------------------------------------------------------------------------------------------------
  217. Set appword = CreateObject("Word.Application.8")
  218. '*----------------------------------------------------------------------------------------------------------------------------------------
  219. '* Create the document variable
  220. '*----------------------------------------------------------------------------------------------------------------------------------------
  221.    Set docWord = appword.Documents.Add()
  222.    Set rngCurrent = docWord.Content
  223.    SenCount = 0
  224. '*----------------------------------------------------------------------------------------------------------------------------------------
  225. '* Cube Title and Header written to Document
  226. '*----------------------------------------------------------------------------------------------------------------------------------------
  227.    With rngCurrent
  228.             .InsertAfter "Report for Sample Cube"
  229.             .InsertAfter vbCrLf
  230.             SenCount = SenCount + 1
  231.             docWord.Paragraphs(SenCount).Range.Bold = True
  232.             docWord.Paragraphs(SenCount).Range.Underline = wdUnderlineSingle
  233.             docWord.Paragraphs(SenCount).Range.Italic = False
  234.             docWord.Paragraphs(SenCount).Range.Font.Size = 18
  235. '*----------------------------------------------------------------------------------------------------------------------------------------
  236. '* Properties of Cube are written to Document
  237. '*----------------------------------------------------------------------------------------------------------------------------------------
  238.  For i = 0 To cdf.Properties.Count - 1
  239.     .InsertAfter "(" & i & ") " & cdf.Properties(i).Name & ": " & cdf.Properties(i).Value
  240.     .InsertAfter vbCrLf
  241.     SenCount = SenCount + 1
  242.     docWord.Paragraphs(SenCount).Range.Bold = False
  243.     docWord.Paragraphs(SenCount).Range.Italic = True
  244.     docWord.Paragraphs(SenCount).Range.Font.Size = 8
  245. Next i
  246. '*----------------------------------------------------------------------------------------------------------------------------------------
  247. '* Dimension Name(s) written to Document
  248. '*----------------------------------------------------------------------------------------------------------------------------------------
  249.           For di = 0 To cdf.Dimensions.Count - 1
  250.             .InsertAfter "Dimension: " & cdf.Dimensions(di).Name
  251.             .InsertAfter vbCrLf
  252.             SenCount = SenCount + 1
  253.             docWord.Paragraphs(SenCount).Range.Bold = True
  254.             docWord.Paragraphs(SenCount).Range.Italic = False
  255.             docWord.Paragraphs(SenCount).Range.Font.Size = 14
  256. '*----------------------------------------------------------------------------------------------------------------------------------------
  257. '* Properties of Dimension are written to Document
  258. '*----------------------------------------------------------------------------------------------------------------------------------------
  259.                 For i = 0 To cdf.Dimensions(di).Properties.Count - 1
  260.                     .InsertAfter "(" & i & ") " & cdf.Dimensions(di).Properties(i).Name & ": " & cdf.Dimensions(di).Properties(i).Value
  261.                     .InsertAfter vbCrLf
  262.                     SenCount = SenCount + 1
  263.                     docWord.Paragraphs(SenCount).Range.Bold = False
  264.                     docWord.Paragraphs(SenCount).Range.Italic = True
  265.                     docWord.Paragraphs(SenCount).Range.Font.Size = 8
  266.                 Next i
  267. '*----------------------------------------------------------------------------------------------------------------------------------------
  268. '* Hierarchy Name(s) written to Document
  269. '*----------------------------------------------------------------------------------------------------------------------------------------
  270.            For hi = 0 To cdf.Dimensions(di).Hierarchies.Count - 1
  271.                 .InsertAfter vbTab & "Hierarchy: " & cdf.Dimensions(di).Hierarchies(hi).Name
  272.                 .InsertAfter vbCrLf
  273.                 SenCount = SenCount + 1
  274.                 docWord.Paragraphs(SenCount).Range.Bold = True
  275.                 docWord.Paragraphs(SenCount).Range.Italic = False
  276.                 docWord.Paragraphs(SenCount).Range.Font.Size = 12
  277. '*----------------------------------------------------------------------------------------------------------------------------------------
  278. '* Properties of Hierarchy are written to Document
  279. '*----------------------------------------------------------------------------------------------------------------------------------------
  280.                     For i = 0 To cdf.Dimensions(di).Hierarchies(hi).Properties.Count - 1
  281.                         .InsertAfter vbTab & "(" & i & ") " & cdf.Dimensions(di).Hierarchies(hi).Properties(i).Name & ": " & cdf.Dimensions(di).Hierarchies(hi).Properties(i).Value
  282.                         .InsertAfter vbCrLf
  283.                         SenCount = SenCount + 1
  284.                         docWord.Paragraphs(SenCount).Range.Bold = False
  285.                         docWord.Paragraphs(SenCount).Range.Italic = True
  286.                         docWord.Paragraphs(SenCount).Range.Font.Size = 8
  287.                     Next i
  288. '*----------------------------------------------------------------------------------------------------------------------------------------
  289. '* Level Name(s) written to Document
  290. '*----------------------------------------------------------------------------------------------------------------------------------------
  291.                 For le = 0 To cdf.Dimensions(di).Hierarchies(hi).Levels.Count - 1
  292.                     .InsertAfter vbTab & vbTab & "Level: " & cdf.Dimensions(di).Hierarchies(hi).Levels(le).Name & " with a Member Count of: " & cdf.Dimensions(di).Hierarchies(hi).Levels(le).Members.Count
  293.                     .InsertAfter vbCrLf
  294.                     SenCount = SenCount + 1
  295.                     docWord.Paragraphs(SenCount).Range.Bold = True
  296.                     docWord.Paragraphs(SenCount).Range.Italic = False
  297.                     docWord.Paragraphs(SenCount).Range.Font.Size = 10
  298. '*----------------------------------------------------------------------------------------------------------------------------------------
  299. '* Properties of Level are written to Document
  300. '*----------------------------------------------------------------------------------------------------------------------------------------
  301.                         For i = 0 To cdf.Dimensions(di).Hierarchies(hi).Levels(le).Properties.Count - 1
  302.                             .InsertAfter vbTab & vbTab & "(" & i & ") " & cdf.Dimensions(di).Hierarchies(hi).Levels(le).Properties(i).Name & ": " & cdf.Dimensions(di).Hierarchies(hi).Levels(le).Properties(i).Value
  303.                             .InsertAfter vbCrLf
  304.                             SenCount = SenCount + 1
  305.                             docWord.Paragraphs(SenCount).Range.Bold = False
  306.                             docWord.Paragraphs(SenCount).Range.Italic = True
  307.                             docWord.Paragraphs(SenCount).Range.Font.Size = 8
  308.                         Next i
  309.                 Next le
  310.             Next hi
  311.         Next di
  312. '*----------------------------------------------------------------------------------------------------------------------------------------
  313. '* Set Word Document to visible
  314. '*----------------------------------------------------------------------------------------------------------------------------------------
  315.         appword.Visible = True
  316.     End With
  317.    Screen.MousePointer = vbDefault
  318. '*----------------------------------------------------------------------------------------------------------------------------------------
  319. '* Set Word Object to nothing to drop OLE connection
  320. '*----------------------------------------------------------------------------------------------------------------------------------------
  321.    Set appword = Nothing
  322. Exit Sub
  323. Error_cmdCreateDocForCube_Click:
  324.     Screen.MousePointer = vbDefault
  325.     MsgBox Err.Description
  326. End Sub
  327.