Question

有没有办法在Excel VBA中执行MDX查询？

我认为它可以通过ADO完成，类似于SQL情况（是的，我知道SQL与MDX不同 - 在Stackoverflow上多次提到的问题）。
不幸的是我找不到任何例子。

有些人讲过使用外部工具来完成这项任务，但是我不想为他们买单。
有些人在XMLA中提供了一些示例，但我想执行简单的MDX查询代替

Answer 1

我们在VBA中调用了以下基于输入MDX字符串的通用函数，将数据写入excel。电子表格确实需要引用ADO和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查询？

1 个答案: