1

Excel VBA内でMDXクエリを実行する方法はありますか?

SQLの場合と同様に、 ADO を介して実行できると思いました（はい、SQLはMDXとは異なることを認識しています-Stackoverflowで何度も言及された問題）。
残念ながら、私は例を見つけることができません。

  • このタスクを達成するために外部ツールを使用することについて話している人もいましたが、私はそれらにお金を払いたくありません.
  • XMLAで例を挙げている人もいますが、代わりに単純なMDXクエリを実行したい

.

4

1 に答える 1

6

入力MDX文字列に基づいてデータをExcelに書き込む、VBAで呼び出される次のジェネリック関数があります。スプレッドシートには、ADOとADOMDへの参照が必要です。

Public Sub DisplayMDX(ipCell, ipMDX, ipExclHeadings)

    Dim sQry As String
    Dim sConnection As String
    Dim rs As ADOMD.Cellset
    Dim sServer, sDB, ts As String
    Dim hyper As Hyperlink
    Dim i, j, k, h, rowStart, colStart, dimCount As Integer
    Dim sURLLink, sCustCaption, sCustLink As String
    Dim db As ADODB.Connection

    'Open a new ADO connection
    Set db = New ADODB.Connection
    sConnection = "Provider=MSOLAP; Data Source=DW3; Initial Catalog=FDMDW1; Integrated Security=SSPI"

    db.CommandTimeout = 0
    db.Open sConnection

    'Open a CellSet to store the results of the query.
    Set rs = New Cellset

    'Tidy the query of an erroneous spaces
    sQry = Trim(ipMDX)

    'Open the query that was constructed above
    Application.StatusBar = "Getting OLAP Data"
    With rs
        .Open sQry, db
    End With

    With ActiveSheet

     'Goto cell specified
     Range(ipCell).Select

     'Find the starting point
     rowStart = ActiveCell.Row
     colStart = ActiveCell.Column
     For j = 0 To rs.Axes(1).Positions.Count - 1

        If Not ipExclHeadings Then
           dimCount = rs.Axes(1).DimensionCount
           For h = 0 To rs.Axes(1).DimensionCount - 1
                Cells(rowStart + j, colStart + h) = rs.Axes(1).Positions(j).Members(h).Caption
           Next
        End If

        For k = 0 To rs.Axes(0).Positions.Count - 1
           If Not (k = 1) Then

              If rs(k, j) <> "" Then
                 Cells(rowStart + j, colStart + dimCount + k).Value = rs(k, j)
              Else
                 Cells(rowStart + j, colStart + dimCount + k).ClearContents
              End If

           End If
           Application.StatusBar = rs(k, j)
        Next

     Next
    End With

rs.Close

Application.StatusBar = "Done"

Exit Sub
errMsg:
   MsgBox Err.Description, vbOKOnly + vbCritical, "Error #" & Err.Number

End Sub
于 2012-06-26T19:09:51.600 に答える