我有一个我在Excel(2010)VBA中执行的MDX查询,但它只返回了一半的记录。
如果我使用相同的MDX查询并在Analysis Services中运行它,它将按预期执行并返回所有记录。
我的变量设置为LONG
,所以这不应该是问题。
提前谢谢。
附加说明: 我试图改变MDX代码,通过使用Season维度来拉入较小的记录集,而不是一次性拉动整年(2014),同样的问题发生。即使通过VBA查询较小的数据集,也只返回一半的记录。我希望有人可以在我的代码中看到我遗漏的内容。
执行MDX查询的Excel VBA(连接到AS以跟随的功能):
Private Sub RefreshDataButton_Click()
'Purpose: Populate data via ADO from TXT based on query.
'Dimension Variables
Dim strSQL As String
Dim gCmd As New ADODB.Command
Dim rsLoadData As New ADODB.Recordset
Dim i As Integer
Dim Conn1 As New ADODB.Connection
Dim SeasonYear As String
Dim PriorYear As String
Dim StartDate As Date
Dim EndDate As Date
Dim TXTYear As Long
''Set up Error Handling
On Error GoTo ErrorHandler
'sheet names
Set Options = Sheets("Options")
Set Lists = Sheets("Lists")
SeasonYear = Options.Range("SeasonYear")
PriorYear = Options.Range("PriorYear")
TXTYear = Options.Range("TXTYear")
'Turn off calculation and screenupdating to speed up the macro
With Application
.ScreenUpdating = False
.DisplayAlerts = False
.EnableEvents = False
.Calculation = xlCalculationManual
.StatusBar = "Connecting to database and running multiple queries..."
End With
Lists.Visible = True
Sheets("Data_TXT").Visible = True
Sheets("Data_TXT").Columns("A:I").Hidden = False
Sheets("Data_TXT").Rows("3:1000000").Delete
'Refresh TXT Data
''Put TXT view/SQL name here
strSQL = "SELECT { [Measures].[WP Inv BOP U F] ,[Measures].[WP Inv BOP AUC incl Back Order],[Measures].[WP To be Keyed U],[Measures].[WP Inv EOP U F] "
strSQL = strSQL & ",[Measures].[WP Receipt U M],[Measures].[WP On Order U],[Measures].[WP To be Placed U],[Measures].[WP Sales U Core KitEvent],[Measures].[WP Inv BOP AUC],[Measures].[WP Receipt AUC F] ,[Measures].[WP Receipt AUC No EDIT] "
strSQL = strSQL & ",[Measures].[WP Sales V Core KitEvent],[Measures].[WP Sales Cst Core KitEvent],[Measures].[WP MMU V Core KitEvent],[Measures].[WP MMU Factor Core KitEvent],[Measures].[WP MMU V Core W PersKitEvent] "
strSQL = strSQL & ",[Measures].[WP Sales V Core],[Measures].[WP Sales V KitEvent],[Measures].[WP Sales V Core W PersKitEvent],[Measures].[WP On Order Cst],[Measures].[WP To be Placed Cst] "
strSQL = strSQL & ",[Measures].[WP To be Keyed Cst M],[Measures].[WP Sales Cst Core W PersKitEvent],[Measures].[WP Receipt Cst M],[Measures].[WP Inv EOP Cost] "
strSQL = strSQL & "} ON COLUMNS,NON EMPTY {([PRODUCT].[Category].[Category].ALLMEMBERS * [PRODUCT].[Style].[Style].ALLMEMBERS * [PRODUCT].[SKU].[SKU].ALLMEMBERS * [TIME].[Month].[Month].ALLMEMBERS)} DIMENSION PROPERTIES MEMBER_CAPTION "
strSQL = strSQL & ",MEMBER_UNIQUE_NAME ON ROWS FROM ( "
strSQL = strSQL & "SELECT ({ [PRODUCT].[Brand].& [2] }) ON COLUMNS FROM (SELECT ({ [LOCATION].[Country].& [3] }) ON COLUMNS "
strSQL = strSQL & "FROM (SELECT ({ [TIME].[Year].& [" & TXTYear & "] }) ON COLUMNS FROM [TOG] ))) "
strSQL = strSQL & "WHERE ([TIME].[Year].& [" & TXTYear & "] ,[LOCATION].[Country].& [3],[PRODUCT].[Brand].& [2]) CELL PROPERTIES VALUE "
strSQL = strSQL & ",BACK_COLOR ,FORE_COLOR,FORMATTED_VALUE ,FORMAT_STRING ,FONT_NAME,FONT_SIZE,FONT_FLAGS "
''Uncomment out for TXT version
Set rsLoadData = GetDataFromADO(strSQL, "TXT")
''Copy Record Set to Excel and Close Recordset
Sheets("Data_TXT").Visible = True
Worksheets("Data_TXT").Select
' rsLoadData.MoveFirst
Sheets("Data_TXT").Range("A2").CopyFromRecordset rsLoadData
rsLoadData.Close
Set rsLoadData = 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("Data").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
连接数据源的功能(已编辑服务器名称):
Function GetDataFromADO(strSQL As String, sServer As String)
'''New code for multiple sources
'Dimension Variables
Dim Conn1 As ADODB.Connection
Dim objCmd As ADODB.Command
Dim rsLoadData As ADODB.Recordset
'Declare variables
Set Conn1 = New ADODB.Connection
Set objCmd = New ADODB.Command
Set rsLoadData = New ADODB.Recordset
Conn1.CommandTimeout = 0
'Open Connection
If sServer = "TXT" Then
'TXT SQL SERVER Analysis connection
Conn1.ConnectionString = "Provider=MSOLAP.4;" & _
"Data Source=DXXXXXXXXXXXAS01;" & _
"Initial Catalog=TOG_Olap;" & _
"Integrated Security=SSPI;Persist Security Info=False;"
Else
'TOG_MPS database connection
Conn1.ConnectionString = "Provider=SQLNCLI10;" & _
"Server=DXXXXXXXXXXXAS01;" & _
"Database=TOG_MPS;" & _
"Integrated Security=SSPI;Persist Security Info=False;"
End If
Conn1.Open
'Set and Excecute SQL Command
Set objCmd.ActiveConnection = Conn1
objCmd.CommandTimeout = 0
objCmd.CommandText = strSQL
objCmd.CommandType = adCmdText
objCmd.Execute
'Open Recordset
Set rsLoadData.ActiveConnection = Conn1
rsLoadData.Open objCmd
'Return and close Recordset
Set GetDataFromADO = rsLoadData
End Function