Transfer SSAS cellset to recordset

I have been using some VBA in Excel to load data from a cube in SQL Servies 2005 Analysis Services into a an Excel worksheet.  This works great.

My problem is that I'm trying to use the code to load the results of the cube into an Access table.
I've attached the code which is used to load the cube cellset into a worksheet.   I need to change this code to load the cellset (rs) into an access table.
I have no idea how to create a recordset.
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
    ' with the worksheet that we passed in (ws)
    With ws
        Dim curRow As Integer ' Just to help explain where we are
        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*'
            If rs.Axes(0).Positions(i).Members.Count = 1 Then
                .Cells(10, intCellY).Value = rs.Axes(0).Positions(i).Members(0).Caption 'header labels
                .Cells(5, intCellY).Value = rs.Axes(0).Positions(i).Members(0).Caption
                .Cells(6, intCellY).Value = rs.Axes(0).Positions(i).Members(1).Caption
            End If
        '* 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 + 10
            '*Shifts the rows down (originally 1)*'
            If rs.Axes(1).Positions(j).Members.Count = 1 Then
                .Cells(intCellX, 1).Value = rs.Axes(1).Positions(j).Members(0).Caption ' row label
                .Cells(intCellX, 1).Value = rs.Axes(1).Positions(j).Members(0).Caption
                .Cells(intCellX, 2).Value = rs.Axes(1).Positions(j).Members(1).Caption
                .Cells(intCellX, 3).Value = rs.Axes(1).Positions(j).Members(2).Caption
                .Cells(intCellX, 4).Value = rs.Axes(1).Positions(j).Members(3).Caption
                .Cells(intCellX, 5).Value = rs.Axes(1).Positions(j).Members(4).Caption
                .Cells(intCellX, 6).Value = rs.Axes(1).Positions(j).Members(5).Caption
                .Cells(intCellX, 7).Value = rs.Axes(1).Positions(j).Members(6).Caption
                .Cells(intCellX, 8).Value = rs.Axes(1).Positions(j).Members(7).Caption
                .Cells(intCellX, 9).Value = rs.Axes(1).Positions(j).Members(8).Caption
            End If
            '* Read in values for corresponding row header
            For k = 0 To rs.Axes(0).Positions.Count - 1
            intCellY = k + 2 'Shifts the numbers to the left - change 2 to according to the number of dimensions set above.
            .Cells(intCellX, intCellY).Value = rs(k, j).FormattedValue
    End With

Open in new window

Who is Participating?
grzegorzsConnect With a Mentor Commented:
The best way in my opinion is to execute MDX query which has one dimension on each axis. Of course you should also have an Access table with structure corresponding to cube dimensions. It should have one column for each dimension to store member key (or caption). You can have two or more columns for dimension member in order to store member captions and other properties. The table should also have one column for each cube measure.

For example - the cube has three dimensions and one measure. MDX Query can look like:
WHERE ([Measures].[My Measure])

The Access table has columns:
The caption of member will be stored in the table.

Code below.

Best regards

'oConnection - connection to SSAS
'mConnection - connection to Access

With mCellset

'Open cellset
.Open sQuery, oConnection

'open recordset to write
Set recSRC = New ADODB.Recordset
recSRC.Open "TableName", mConnection, adOpenKeyset, adLockPessimistic, adCmdTableDirect

'Check if we have any results
If .Axes(0).Positions.Count > 0 Then
  For nDim1 = 0 To .Axes(0).Positions.Count - 1
    sD1Caption = .Axes(0).Positions(nDim1).Members(0).Caption
    For nDim2 = 0 To .Axes(1).Positions.Count - 1
      sD2Caption = .Axes(1).Positions(nDim2).Members(0).Caption
      For nDim3 = 0 To .Axes(2).Positions.Count - 1
        sD3Caption = .Axes(1).Positions(nDim3).Members(0).Caption
        'cell value
        sValue = mCellset(nDim1, nDim2, nDim3).Value
        'is null?
        If Not IsNull(sValue) Then
          With recSRC
            !Dimension1 = sD1Caption
            !Dimension2 = sD2Caption
            !Dimension3 = sD3Caption
            !MeasureValue = sValue
          End With
        End If 'Not IsNull(sValue)
End If

'close recordset

'close cellset

End With

Open in new window

1. You can use the xls to export data into MS access
2. Why do you need CUBE? You can create an export file and load MS access db directly through SQL server
lee_jdAuthor Commented:
I ahve the data in a cube in analysis services.  I need to get the data from the cube into Access.  I don't want to load the data into Excel as it's too large.  I need to take it straight into Access.  I'm sure it can be done.   I've got the part where I have the cube in memory in a cellset object.   I just need to move this data into a table.
sameer2010Connect With a Mentor Commented:
You can define a datasource to MS access db. And then use the code similar to the following...

Dim testDatasource As SqlDataSource = New SqlDataSource()
testDatasource.ConnectionString = "...." <<--map this to your connection db details
testDatasource.ProviderName = "...." <<---- map this to your version of access
testDatasource.InsertCommand = "INSERT INTO [tblaccess] ([UserName], [Address]) VALUES (@UserName, @Address)"
Loop until end of cellset
        testDatasource.InsertParameters.Add("UserName", CS(1,1).FormattedValue)
        testDatasource.InsertParameters.Add("Address", CS(r,c).FormattedValue)

Open in new window

lee_jdAuthor Commented:
Thanks for your help.  This solved my problem.
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

All Courses

From novice to tech pro — start learning today.