Excel vba中有任何MDX查询吗?

本文介绍了Excel vba中有任何MDX查询吗?的处理方法，对大家解决问题具有一定的参考价值，需要的朋友们下面随着小编来一起学习吧！ 问题描述

是否可以在Excel VBA中执行MDX查询?

我认为可以通过 ADO 来完成，类似于SQL情况(是的，请注意，SQL与MDX不同-在Stackoverflow上已多次提及该问题). 不幸的是，我找不到任何示例.

is there any way to execute MDX query within Excel VBA?

I thought that it can be done through ADO, similarly as in SQL case (yes, I'm aware that SQL is different than MDX - issue which was mentioned many times on Stackoverflow). Unfortunately I can't find any examples.

• 有人告诉我要使用外部工具来完成此任务，但我 不想为他们付费.
• 有人在XMLA中给出了一个例子，但我想执行简单的MDX查询 代替

• Some told about using external tools to accomplish this task, but I don't want to pay for them.
• Some give an examples in XMLA, but I want to execute simple MDX query instead

.

推荐答案

我们在VBA中调用了以下通用函数，该函数基于输入的MDX字符串，将数据写入excel.电子表格确实需要引用ADO和ADOMD

We have the following generic function that's called in VBA that based on an input MDX string, writes the data to excel. The spreadsheet does require a reference to ADO and ADOMD

Public Sub DisplayMDX(ipCell, ipMDX, ipExclHeadings) Dim sQry As String Dim sConnection As String Dim rs As ADOMD.Cellset Dim sServer, sDB, ts As String Dim hyper As Hyperlink Dim i, j, k, h, rowStart, colStart, dimCount As Integer Dim sURLLink, sCustCaption, sCustLink As String Dim db As ADODB.Connection 'Open a new ADO connection Set db = New ADODB.Connection sConnection = "Provider=MSOLAP; Data Source=DW3; Initial Catalog=FDMDW1; Integrated Security=SSPI" db.CommandTimeout = 0 db.Open sConnection 'Open a CellSet to store the results of the query. Set rs = New Cellset 'Tidy the query of an erroneous spaces sQry = Trim(ipMDX) 'Open the query that was constructed above Application.StatusBar = "Getting OLAP Data" With rs .Open sQry, db End With With ActiveSheet 'Goto cell specified Range(ipCell).Select 'Find the starting point rowStart = ActiveCell.Row colStart = ActiveCell.Column For j = 0 To rs.Axes(1).Positions.Count - 1 If Not ipExclHeadings Then dimCount = rs.Axes(1).DimensionCount For h = 0 To rs.Axes(1).DimensionCount - 1 Cells(rowStart + j, colStart + h) = rs.Axes(1).Positions(j).Members(h).Caption Next End If For k = 0 To rs.Axes(0).Positions.Count - 1 If Not (k = 1) Then If rs(k, j) <> "" Then Cells(rowStart + j, colStart + dimCount + k).Value = rs(k, j) Else Cells(rowStart + j, colStart + dimCount + k).ClearContents End If End If Application.StatusBar = rs(k, j) Next Next End With rs.Close Application.StatusBar = "Done" Exit Sub errMsg: MsgBox Err.Description, vbOKOnly + vbCritical, "Error #" & Err.Number End Sub