Querying Analysis Services with VBA

Many people use excel pivot tables as a means of retrieving data from an Analysis Services OLAP cube. This is okay for most situations where you want a quick way of retrieving data for analytical purposes. However, there is a different way to do it using VBA to access the OLEDB driver.

This is not as easy as the point and click pivot method, however once the code is set up it can used over and over, additionally with a little knowledge of MDX you can build powerful queries dynamically based on user selections.

It works as follows:

  1. One or more MDX queries are written onto a worksheet called MDX.
  2. You have the option to parameterise each query with simple string manipulation.
  3. Each query produces data that is loaded to separate worksheets.

The technical part is:

  1. A connection is made to analysis services.
  2. The MDX is loaded to a string
  3. Parameters are parsed
  4. The MDX is pushed to the server and cube set object is returned
  5. This cube set object is moved into a regular array
  6. The array is loaded in one pass to the worksheet.

You can create the MDX by hand (for those highly skilled people) or you can use another tool to generate the MDX.

The attached workbook contains sample classes along with some example MDX.  This sample file connects with the commonly available sample : Adventure Works.   You will need to have this sample installed and deployed on your Analysis Services server to make use of this example.

To use the sample file against your own server all you need to do is amend the connection string.

If you are a non technical user you should ask your Database Administrator for help with the connection string.

This is not a perfect reporting solution as the distributed nature of workbooks is harder to maintain. You can mitigate risks by setting an expiry date in the workbook or linking the version control back to a server.

Load these standard excel reports to your Intranet rather than emailing them to users and make this the limit of your support.

There is one limitation – the oledb driver doesn’t seem to  expose the number of columns hence I’ve had to use a constant value in the array.  However, this should cover most situations.

If you prefer not to download workbooks from the Intranet I have added the code below, however, I recommend you use the example file as this contains the pre-requisite worksheets with sample MDX queries, including a parameterised version of  a query.

To create the code yourself using the source code below you should start by creating a new VBA module called AppGlobals and paste in the connection string below. It is this code that contains the ConnectionString that you will need to amend.

Public Const OLAP_CNN_STR As String = "Provider=MSOLAP.4;Integrated Security=SSPI;Persist Security Info=True;Data Source=laptop;Initial Catalog=Adventure Works DW 2008R2 SE"

Create a VBA module called Func. This module contains the functions used to call the classes and provides some other supporting functions that manipulates the MDX by adding in the parameters prior to the query being called on the server.

Sub QueryCaller()

On Error GoTo Err

Dim mdx As String
Dim replacement As String
Dim lr, sr, a, p As Integer
Dim sd As Integer
Dim c As Variant
Dim sht As String
Dim z As Integer
Dim startrow As Integer
Dim er As Integer
Dim r As Integer
Application.ScreenUpdating = False

Application.Calculation = xlCalculationManual

With mdxsht

r = 26

For z = r To 1000

If .Cells(z, 2) <> "" Then

   If .Cells(z, 2) <> "END" Then
    startrow = z + 1
    sht = .Cells(z, 2)

    End If

    If .Cells(z, 2) = "END" Then
        er = z - 1
        Call CaptureMDX(startrow, er, sht) ' this code loops through the MDX sheet and collects each MDX statement over several lines.
    End If

End If

Next z

End With

Application.Calculation = xlCalculationAutomatic

Application.ScreenUpdating = True
MsgBox ("Data retrieval complete")

Exit Sub

Err:

Select Case Err.Number

    Case 3265
        ReportError ("No data has been found in the cube.  Please change your filters and try again.")
    Case Else
        ReportError ("An error has occurred.  Please contact ... for support.") & Chr(10) & Chr(10) & Err.Description

End Select

Application.Calculation = xlCalculationAutomatic

Application.ScreenUpdating = True

End Sub

Sub RemoveCubeData(s As String)

Worksheets(s).Rows("10:65536").ClearContents

End Sub

Function LastColumn(sh As Worksheet, row As Long) As Long

    LastColumn = sh.Range("IV" & row).End(xlToLeft).column

End Function

Function LastRow(sh As Worksheet, column As Long) As Long

    LastRow = sh.Cells(65536, column).End(xlUp).row

End Function

Sub ReportError(s As String)

MsgBox s, vbCritical, "Error"

End Sub

Function cname(sr As String) As String

cname = Worksheets(sr).CodeName

End Function

Sub CaptureMDX(srow As Integer, endrow As Integer, sht As String)

Dim x As OlapRetrieve
Set x = New OlapRetrieve
Dim mdx As String

RemoveCubeData (sht)

Call x.SetCnnString(AppGLobals.OLAP_CNN_STR)

lr = endrow

sr = srow ' start row of the MDX statement

mdx = ""

With mdxsht

       For sd = sr To lr   'loop through the MDX query held on the sheet

                mdx = mdx & .Cells(sd, 3) & " "  'Build a string from the cells on the worksheet

       Next sd

        For p = 1 To 20  ' Loop through the parameters

            replacement = Worksheets("ChooseParameters").Cells(p + 1, 3) 'replace the parameter values in the MDX with the values on the worksheet.

            mdx = Replace(mdx, "PARAM" & p, replacement)

        Next p

End With

Call x.WriteMdxResult(mdx, Worksheets(sht), 0, 0)

Set x = Nothing

End Sub

Create a Class Module called : OlapRetrieve and paste in the code below. This code contains the main methods to query the cube and return the results back to the Excel worksheet.

Private cnn As adodb.Connection
Private cnnStr As String

Public Sub SetCnnString(sCnn As String)

    ' Make the connection string immutable.

    If cnnStr = sCnn Then
        Return
    ElseIf cnnStr = "" Then
        cnnStr = sCnn
    ElseIf cnnStr <> sCnn Then
        Err.Raise -1, "OlapRetrieve", "A connection is already active and is immutable."
    End If

End Sub

Public Sub CnnWriteMdxResult(sQ As String, sCnn As String, row As Integer, col As Integer, ByRef ws As Worksheet)

    Call SetCnnString(sCnn)
    Call WriteMdxResult(sQ, ws, row, col)

End Sub

Public Sub WriteMdxResult(sQ As String, ByRef ws As Worksheet, startrow As Integer, startCol As Integer)

    Dim sQry As String
    Dim sConnection As String
    Dim rs As Cellset
    Dim i As Integer, j As Integer, k As Integer
    Dim intCellY As Integer, intCellX As Integer
    Dim Product As String
    Dim Cover As String
    Dim STD As String
    Dim SelfIssue As String
    Dim rng() As Variant

    sQry = sQ

    Call OpenCnn

    'Open a CellSet to store the results of the query.
    Set rs = New Cellset

    'Tidy the query of an erroneous spaces
    sQry = Trim(sQry)

    'Open the query that was constructed above
    With rs
        .Open sQry, cnn
    End With

    ReDim rng(rs.Axes(1).Positions.Count + 10, rs.Axes(0).Positions.Count + 10)

    ' with the worksheet that we passed in (ws)
    With ws
        Dim curRow As Integer
        curRow = startrow
        '*--------------------------------------------------------------------------------------------------
        '* Read in Column Header

        '*--------------------------------------------------------------------------------------------------
        For i = 0 To rs.Axes(0).Positions.Count - 1
            intCellY = startCol + i + rs.Axes(1).Positions(0).Members.Count + 1 '  change 1 if extra dimensions are added.
            '*Moves the Header across*'

            For fg = 1 To 1 + rs.Axes(0).Positions(i).Members.Count - 1
               rng(fg, intCellY) = rs.Axes(0).Positions(i).Members(fg - 1).Caption 'header labels

            Next fg

        Next

        '*--------------------------------------------------------------------------------------------------
        '* Read in Row Header

        '*--------------------------------------------------------------------------------------------------
        For j = 0 To rs.Axes(1).Positions.Count - 1
            'intCellX = j + 1

            intCellX = j + rs.Axes(0).Positions(0).Members.Count + 1

            For af = 0 To rs.Axes(1).Positions(j).Members.Count - 1

                rng(intCellX, af + 1) = rs.Axes(1).Positions(j).Members(af).Caption

            Next af

            '*--------------------------------------------------------------------------------------------------
            '* Read in values for corresponding row header

            '*--------------------------------------------------------------------------------------------------
            For k = 0 To rs.Axes(0).Positions.Count - 1
            intCellY = k + rs.Axes(1).Positions(0).Members.Count + 1 'Shifts the numbers to the left - change 2 to according to the number of dimensions set above.
            rng(intCellX, intCellY) = rs(k, j).FormattedValue
            Next
        Next
    End With

ws.Range("A10").Resize(rs.Axes(1).Positions.Count + 10, rs.Axes(0).Positions.Count + 10).Value = rng

End Sub

Private Sub OpenCnn()

    If cnnStr = "" Then
        Err.Raise -1, "Connection String Not Provided."
    End If

    If cnn Is Nothing Then
        'Open a new ADO connection
        Set cnn = New adodb.Connection
    End If

    If cnn.State = adodb.ObjectStateEnum.adStateClosed Then
        cnn.Open cnnStr
    End If

End Sub

Private Sub CloseCnn()

    If Not cnn Is Nothing Then
        If cnn.State <> adodb.ObjectStateEnum.adStateClosed Then
            cnn.Close
        End If
        ' Dispose of the conneection
         Set cnn = Nothing
    End If

End Sub

Private Sub Class_Initialize()
    ' Default Values
    cnnStr = ""

End Sub

Private Sub Class_Terminate()

    CloseCnn

End Sub

To execute the code you need to call the function : QueryCaller

This sample code is linked to the worksheets in my example file i.e. MDX, ChooseParameters. You will need to re-create these worksheet before using the code.  As I mentioned above, it’s easier if you download the sample workbook.

I hope you find the code useful. Please feel free to share any comments you have.

About Lee Hawthorn

Business Intelligence Consultant
This entry was posted in Analysis Services and tagged , , . Bookmark the permalink.

5 Responses to Querying Analysis Services with VBA

  1. Anand says:

    Nice one

  2. Eric Engel says:

    Wow, this is amazingly useful and works great. I can not even begin to tell you the amount of time that you have saved me by posting this!

  3. Tom Mason says:

    Unfortunately the link to the sample workbook isn’t working. Are you able to make the file available as I’m very interested in using this approach.

    • Lee Hawthorn says:

      I think dropbox have stopped providing public file shares. Let me find a new way of sharing the content and I’ll comment here. Busy for the next 3 days so don’t expect to hear from me before then.

Leave a Reply