使用VBA获取MDX数据

我很难在Excel中连接到MDX数据库的结果。 下面是我的代码（我非常新，所以请耐心等待。）我劫持了某人的错误代码，所以这部分不是我的。 查询运行，但我没有收到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