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 Idon't want to pay for them.
• Some give an examples in XMLA, but I want to execute simple MDX queryinstead

.

推荐答案

我们在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

这篇关于Excel vba中有任何MDX查询吗?的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持！