Excel(2010)中的MDX查询VBA仅返回一半记录

时间:2014-04-24 14:39:17

标签: excel vba mdx

我有一个我在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

0 个答案:

没有答案