Updated on 2019.06.18: Code corrected to support properties like PARENTx, performance improved.
Updated on 2019.06.14: Code corrected to support proper case for short ID.
Updated on 2019.06.13: Late binding to work on EPM or AO.
Decided to share simple code to get list of dimension members having some property value. The standard EPM API function is missing for this task. The code can be easily changed to support multiple properties for selection
The following references are required in Tools -> References:
Parameters are described in the code:
Procedure to test GetMembersByProperty function:
The results of this function can be used for different checks, for DM package answer prompt generation (Simple VBA procedure to pass parameters to DM packages) etc. You can even create your own member selector using VBA listbox as a replacement of OpenFilteredMemberSelector API.
Sample of Member Selector:
Create User Form frmSelectMembers with 3 elements:
lbxMembers - ListBox
cmbOK - CommandButton
cmbCancel - CommandButton
Add code to the frmSelectMembers code:
Add the code to some module to launch Member Selector function SelectMembersFilt:
If you run SelectMembersTest you will have something like:
Result in the Immediate window will be:
PC_PL00-00011
PC_PL01-00000
PC_PL01-00001
The standard API function OpenFilteredMemberSelector can be used with the code:
With the form presented to user:
Extra button has to be clicked to perform selection.
GetMembersByProperty can be slow for dimensions with a huge member list (all members of dimension are read inside this code).
Vadim
P.S. epm.GetPropertyValue function was replaced by Application.Run("EPMMemberProperty"... to improve performance based on evgenij.samardak comment!
References:
BPC NW 10: VBA to get dimension members list and properties
Updated on 2019.06.14: Code corrected to support proper case for short ID.
Updated on 2019.06.13: Late binding to work on EPM or AO.
Decided to share simple code to get list of dimension members having some property value. The standard EPM API function is missing for this task. The code can be easily changed to support multiple properties for selection
The following references are required in Tools -> References:
Parameters are described in the code:
Option Explicit
'References to Microsoft Scripting Runtime required
Public Function GetMembersByProperty(strConn As String, _
strDim As String, strProperty As String, _
strPropValue As String, blnFullMember As Boolean) As String()
'Parameters: strConn - Connection string, strDim - Dimension name,
'strProperty - Property name, strPropValue - Property value,
'blnFullMember - True: result as full name [DIMNAME].[PARENTHx].[MEMBERID]
'False: result as MEMBERID
'Result: Array of strings. If first element is "" then nothing found
'and second element - error reason
Dim objAddIn As COMAddIn
Dim epm As Object
Dim AOComAdd As Object
Dim blnEPMInstalled As Boolean
Dim strDims() As String
Dim strProps() As String
Dim blnExistFlag As Boolean
Dim blnPARENTH As Boolean
Dim lngDimHierPref As Long
Dim strDimHierPref As String
Dim strMem() As String
Dim strMemID As String
Dim dctMembers As New Scripting.Dictionary
Dim varPropVal As Variant
Dim varMemFull As Variant
Dim lngTemp As Long
Dim lngTemp1 As Long
On Error GoTo Err
'Universal code to get FPMXLClient for standalone EPM or AO
For Each objAddIn In Application.COMAddIns
If objAddIn.progID = "FPMXLClient.Connect" Then
Set epm = objAddIn.Object
blnEPMInstalled = True
Exit For
ElseIf objAddIn.progID = "SapExcelAddIn" Then
Set AOComAdd = objAddIn.Object
Set epm = AOComAdd.GetPlugin("com.sap.epm.FPMXLClient")
blnEPMInstalled = True
Exit For
End If
Next objAddIn
If Not blnEPMInstalled Then
ReDim strMem(0 To 1)
strMem(0) = ""
strMem(1) = "NO_EPM"
GetMembersByProperty = strMem
Exit Function
End If
'Check if Dimension strDim exists
strDims = epm.GetDimensionList(strConn)
For lngTemp = 0 To UBound(strDims)
If strDims(lngTemp) = strDim Then
blnExistFlag = True
End If
Next lngTemp
Erase strDims
If Not blnExistFlag Then
ReDim strMem(0 To 1)
strMem(0) = ""
strMem(1) = "NO_DIMENSION"
GetMembersByProperty = strMem
Exit Function
End If
'Check if Property strProperty exists for Dimension strDim
blnExistFlag = False
strProps = epm.GetPropertyList(strConn, strDim)
For lngTemp = 0 To UBound(strProps)
If strProps(lngTemp) = strProperty Then
blnExistFlag = True
End If
Next lngTemp
Erase strProps
If Not blnExistFlag Then
ReDim strMem(0 To 1)
strMem(0) = ""
strMem(1) = "NO_PROPERTY"
GetMembersByProperty = strMem
Exit Function
End If
'Test for Properties like PARENTHx
If strProperty Like "PARENTH*" Then
blnPARENTH = True
lngDimHierPref = Len(strDim) + Len(strProperty) + 5 'Len of "[DIMNAME].[PARENTHx]"
strDimHierPref = "[" & strDim & "].[" & strProperty 'String like "[DIMNAME].[PARENTHx"
End If
'Get full list of dimension members with duplicates due to possible multiple hierarchies
strMem = epm.GetHierarchyMembers(strConn, "", strDim)
For lngTemp = 0 To UBound(strMem)
lngTemp1 = InStrRev(strMem(lngTemp), "[")
strMemID = Mid(strMem(lngTemp), lngTemp1 + 1, Len(strMem(lngTemp)) - lngTemp1 - 1)
'Add only unique member ID's (ID in upper case!)
If Not dctMembers.Exists(strMemID) Then
dctMembers.Add strMemID, strMem(lngTemp)
End If
Next lngTemp
'Loop dictionary with unique member list and read Property value
lngTemp = 0
For Each varMemFull In dctMembers.Items
'Check member proprty value
'Corrected based on Evgeniy Samardak comment!
'Application.Run("EPMMemberProperty" instead of epm.GetPropertyValue(
If blnPARENTH Then
'For PARENTx properties
strMemID = strDimHierPref & Mid(varMemFull, lngDimHierPref)
varPropVal = Application.Run("EPMMemberProperty", "", strMemID, strProperty)
If varPropVal = "The member requested does not exist in the specified hierarchy." Or _
varPropVal = 0 Then
varPropVal = ""
End If
Else
'For other properties
varPropVal = Application.Run("EPMMemberProperty", "", CStr(varMemFull), strProperty)
End If
If varPropVal = strPropValue Then
If blnFullMember Then
strMem(lngTemp) = CStr(varMemFull)
Else
'Get ID in proper case
strMem(lngTemp) = CStr(Application.Run("EPMMemberProperty", "", CStr(varMemFull), "ID"))
End If
lngTemp = lngTemp + 1
End If
Next varMemFull
Set dctMembers = Nothing
If lngTemp = 0 Then
ReDim strMem(0 To 1)
strMem(0) = ""
strMem(1) = "NO_MATCH"
Else
ReDim Preserve strMem(0 To lngTemp - 1)
End If
GetMembersByProperty = strMem
Exit Function
Err:
ReDim strMem(0 To 1)
strMem(0) = ""
If Err.Number = -1073479167 Then
strMem(1) = "NO_CONNECTION"
Else
strMem(1) = "OTHER_ERROR"
End If
GetMembersByProperty = strMem
End FunctionProcedure to test GetMembersByProperty function:
Public Sub Test()
Dim objAddIn As COMAddIn
Dim epm As Object
Dim AOComAdd As Object
Dim blnEPMInstalled As Boolean
Dim strMem() As String
Dim lngTemp As Long
'Universal code to get FPMXLClient for standalone EPM or AO
For Each objAddIn In Application.COMAddIns
If objAddIn.progID = "FPMXLClient.Connect" Then
Set epm = objAddIn.Object
blnEPMInstalled = True
Exit For
ElseIf objAddIn.progID = "SapExcelAddIn" Then
Set AOComAdd = objAddIn.Object
Set epm = AOComAdd.GetPlugin("com.sap.epm.FPMXLClient")
blnEPMInstalled = True
Exit For
End If
Next objAddIn
If Not blnEPMInstalled Then
MsgBox "EPM is not installed!"
Exit Sub
End If
strMem = GetMembersByProperty(epm.GetActiveConnection(ThisWorkbook.Worksheets("Sheet1")), _
"SOMEDIMNAME", "SOMEPROPERTYNAME", "SOMEPROPERTYVALUE", False)
If strMem(0) = "" Then
Debug.Print strMem(1)
Else
For lngTemp = 0 To UBound(strMem)
Debug.Print strMem(lngTemp)
Next lngTemp
End If
End SubThe results of this function can be used for different checks, for DM package answer prompt generation (Simple VBA procedure to pass parameters to DM packages) etc. You can even create your own member selector using VBA listbox as a replacement of OpenFilteredMemberSelector API.
Sample of Member Selector:
Create User Form frmSelectMembers with 3 elements:
lbxMembers - ListBox
cmbOK - CommandButton
cmbCancel - CommandButton
Add code to the frmSelectMembers code:
Option Explicit
Private blnOKPressed As Boolean
Private Sub cmbCancel_Click()
Unload Me
End Sub
Private Sub cmbOK_Click()
Dim lngTemp As Long
Dim lngTemp1 As Long
blnOKPressed = True
'Read selected items
For lngTemp = 0 To Me.lbxMembers.ListCount - 1
If Me.lbxMembers.Selected(lngTemp) Then
strMembs(lngTemp1) = Me.lbxMembers.List(lngTemp)
lngTemp1 = lngTemp1 + 1
End If
Next lngTemp
If lngTemp1 = 0 Then
ReDim strMembs(0 To 0)
strMembs(0) = ""
Else
ReDim Preserve strMembs(0 To lngTemp1 - 1)
End If
Unload Me
End Sub
Private Sub UserForm_Initialize()
Dim lngTemp As Long
Me.Caption = "Select Members for " & strDimName & " Dimension"
With Me.lbxMembers
.ColumnCount = 1
.ColumnWidths = "100"
.Font.Size = 10
.MultiSelect = fmMultiSelectMulti
For lngTemp = 0 To UBound(strMembs)
.AddItem
.List(lngTemp, 0) = strMembs(lngTemp)
Next lngTemp
End With
End Sub
Private Sub UserForm_Terminate()
If Not blnOKPressed Then
ReDim strMembs(0 To 0)
strMembs(0) = ""
End If
End SubAdd the code to some module to launch Member Selector function SelectMembersFilt:
Option Explicit
'Globals to pass data to and from form
Public strMembs() As String
Public strDimName As String
Public Function SelectMembersFilt(strConn As String, strDim As String, strProperty As String, _
strPropValue As String) As String()
Dim lngTemp As Long
'Set global variables: strDimName and strMembs
strDimName = strDim
strMembs = GetMembersByProperty(strConn, strDimName, strProperty, strPropValue, False)
'Load form if member list is not empty
If strMembs(0) = "" Then
Debug.Print strMembs(1)
Else
frmSelectMembers.Show vbModal
End If
SelectMembersFilt = strMembs
End Function
Public Sub SelectMembersTest()
Dim objAddIn As COMAddIn
Dim epm As Object
Dim AOComAdd As Object
Dim blnEPMInstalled As Boolean
Dim strMem() As String
Dim lngTemp As Long
'Universal code to get FPMXLClient for standalone EPM or AO
For Each objAddIn In Application.COMAddIns
If objAddIn.progID = "FPMXLClient.Connect" Then
Set epm = objAddIn.Object
blnEPMInstalled = True
Exit For
ElseIf objAddIn.progID = "SapExcelAddIn" Then
Set AOComAdd = objAddIn.Object
Set epm = AOComAdd.GetPlugin("com.sap.epm.FPMXLClient")
blnEPMInstalled = True
Exit For
End If
Next objAddIn
If Not blnEPMInstalled Then
MsgBox "EPM is not installed!"
Exit Sub
End If
strMem = SelectMembersFilt(epm.GetActiveConnection(ThisWorkbook.Worksheets("Sheet1")), _
"SOMEDIMNAME", "SOMEPROPERTYNAME", "SOMEPROPERTYVALUE")
'List selected members
If strMem(0) = "" Then
Debug.Print "Nothing Selected"
Else
For lngTemp = 0 To UBound(strMem)
Debug.Print strMem(lngTemp)
Next lngTemp
End If
End SubIf you run SelectMembersTest you will have something like:
Result in the Immediate window will be:
PC_PL00-00011
PC_PL01-00000
PC_PL01-00001
The standard API function OpenFilteredMemberSelector can be used with the code:
Public Sub SelectMembers()
Dim objAddIn As COMAddIn
Dim epm As Object
Dim AOComAdd As Object
Dim blnEPMInstalled As Boolean
Dim strMembers As String
Dim strMem() As String
Dim lngTemp As Long
Dim lngTemp1 As Long
'Universal code to get FPMXLClient for standalone EPM or AO
For Each objAddIn In Application.COMAddIns
If objAddIn.progID = "FPMXLClient.Connect" Then
Set epm = objAddIn.Object
blnEPMInstalled = True
Exit For
ElseIf objAddIn.progID = "SapExcelAddIn" Then
Set AOComAdd = objAddIn.Object
Set epm = AOComAdd.GetPlugin("com.sap.epm.FPMXLClient")
blnEPMInstalled = True
Exit For
End If
Next objAddIn
If Not blnEPMInstalled Then
MsgBox "EPM is not installed!"
Exit Sub
End If
strMembers = epm.OpenFilteredMemberSelector( _
epm.GetActiveConnection(ThisWorkbook.Worksheets("Sheet1")), _
"SOMEDIMNAME", "", "SOMEPROPERTYNAME=SOMEPROPERTYVALUE", True)
If strMembers <> "" Then
strMembers = Left(strMembers, Len(strMembers) - 1)
strMem = Split(strMembers, ";")
For lngTemp = 0 To UBound(strMem)
lngTemp1 = InStrRev(strMem(lngTemp), "[")
strMem(lngTemp) = Mid(strMem(lngTemp), lngTemp1 + 1, _
Len(strMem(lngTemp)) - lngTemp1 - 1)
Debug.Print strMem(lngTemp)
Next lngTemp
Else
Debug.Print "Nothing selected"
End If
End SubWith the form presented to user:
Extra button has to be clicked to perform selection.
GetMembersByProperty can be slow for dimensions with a huge member list (all members of dimension are read inside this code).
Vadim
P.S. epm.GetPropertyValue function was replaced by Application.Run("EPMMemberProperty"... to improve performance based on evgenij.samardak comment!
References:
BPC NW 10: VBA to get dimension members list and properties
- SAP Managed Tags:
12 Comments
