Any MDX query within Excel vba?

Question

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.

• 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

.

Answer 1

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