VBAを使用してMDXデータを取得する

Question

MDXデータベースに接続するExcelで結果を取得するのが苦労しています。以下は私のコードです（私はこれで信じられないほど新しいので、気をつけてください）。私は誰かのエラーコードを乗っ取ったので、その部分は私のものではありません。クエリは実行されますが、Excelではデータは受信されません。どんな助けもありがとう。

Sub Test()  
    Sheets("DataDump").Select 
    ActiveSheet.Range("A1").Value = "Department" 

    Set cn = New ADODB.Connection 
    cn.Open "provider=MSOLAP.3;Integrated Security=SSPI;Persist Security Info=True;Initial Catalog=XXX;Data Source=XXXXX;MDX Compatibility=1;Safety Options=2;MDX Missing Member Mode=Error" 
    Set rs = New ADODB.Recordset  

    strSQL = "select [product].[base color] on columns " 
    strSQL = strSQL & " From XXX " 
    strSQL = strSQL & " Where [Date].[Fiscal Week].&[2016]&[10] " 

    rs.Open strSQL, cn 

    Sheets("DataDump").Range("A2").CopyFromRecordset rs 

    rs.Close 
    Set rs = Nothing 

    Set Lists = Nothing 
    strSQL = vbNullString 
    StartDate = 0 
    EndDate = 0 
    SeasonYear = vbNullString 
    PriorYear = vbNullString 
    TXTYear = 0 

    With Application 
     .ScreenUpdating = True 
     .DisplayAlerts = True 
     .Calculation = xlCalculationAutomatic 
     .EnableEvents = True 
     .StatusBar = False 
    End With  
Exit Sub 

ErrorHandler: 

    Sheets("DataDump").Visible = xlVeryHidden 

    Set Lists = Nothing 
    strSQL = vbNullString 
    StartDate = 0 
    EndDate = 0 
    SeasonYear = vbNullString 
    PriorYear = vbNullString 
    TXTYear = 0 

    With Application 
     .ScreenUpdating = True 
     .DisplayAlerts = True 
     .Calculation = xlCalculationAutomatic 
     .EnableEvents = True 
     .StatusBar = False 
    End With 

    'Error Message 
    MsgBox "An Error occurred while retrieving data: " & Err.Description 
End Sub 

Answer 1

ここでは、vbaを使用して直立キューブに移動する例を示します。

この追加オブジェクトADOMD.Cellsetを使用して、mdxの結果を取得しました。

Sub getFromCube() 

Dim strConn As String 
strConn = _ 
    "Provider=MSOLAP.6;" & _ 
    "Data Source=imxxxxxx;" & _          '<<<name of your server here 
    "Initial Catalog=AdventureWorksDW2012Multidimensional-EE;" & _ '<<<name of your Adv Wrks db here 
    "Integrated Security=SSPI" 

Dim pubConn As ADODB.Connection 
Set pubConn = New ADODB.Connection 
pubConn.CommandTimeout = 0 
pubConn.Open strConn 

Dim cs As ADOMD.Cellset 
Set cs = New ADOMD.Cellset 

Dim myMdx As String 
myMdx = _ 
    " SELECT" & _ 
    " NON EMPTY" & _ 
    " [Customer].[Customer Geography].[State-Province].&[AB]&[CA] ON 0," & _ 
    " NON EMPTY" & _ 
    " [Measures].[Internet Sales Amount] ON 1" & _ 
    " FROM [Adventure Works];" 

With cs 
    .Open myMdx, pubConn 
    ActiveSheet.Range("A1") = cs(0, 0) 
    .Close 
End With 


End Sub