PGSystemTester

BPCzar Suggested Code

Dec 24th, 2018
109
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  1. 'suggested from: https://www.linkedin.com/feed/update/urn:li:linkedInArticle:6481765814872739840/
  2. 'Ensure that FPMLCLient is enabled in references as well as Microsoft Scripting Runtime (to work with dictionary object)
  3.  
  4.     Const PropertyTocheck As String = "CALC"
  5.     Const DimsToExclude As String = "_MEASURES_CATEGORY_SCENARIO_VERSION_RPTCURRENCY_CURRENCY_FLOW_AUDITTRAIL_DATASRC"
  6.     Const dimExtender As Long = 20 'use this number to increase your dimensions by a factor
  7.    
  8.  
  9. Enum CalcMethods
  10.     eCalc_Evaluate = 1
  11.     eCalc_API = 2
  12.     eCalc_RunTime = 3
  13. End Enum
  14.  
  15. Option Explicit
  16.  
  17. Sub LoopALLDimensions()
  18.     'Run this macro!
  19.  
  20.     Dim epm As FPMXLClient.EPMAddInAutomation: Set epm = New FPMXLClient.EPMAddInAutomation
  21.     Dim AllMyDims() As String: AllMyDims = epm.GetDimensionList(epm.GetActiveConnection(ActiveSheet))
  22.    
  23.     Dim Dim_X As Long, m As CalcMethods
  24.    
  25.     For Dim_X = 0 To UBound(AllMyDims)
  26.         If InStr(1, DimsToExclude, AllMyDims(Dim_X), vbTextCompare) = 0 Then
  27.            
  28.             Debug.Print AllMyDims(Dim_X)
  29.             For m = eCalc_Evaluate To eCalc_RunTime
  30.                 Call GetProp(AllMyDims(Dim_X), m, PropertyTocheck)
  31.             Next m
  32.         End If
  33.        
  34.     Next Dim_X
  35.    
  36. MsgBox "Task Completed"
  37.  
  38. End Sub
  39.  
  40.  
  41.  
  42. Private Sub GetProp(strDim As String, methodToCalc As Long, strProperty As String)
  43.  
  44.     Dim epm As FPMXLClient.EPMAddInAutomation: Set epm = New FPMXLClient.EPMAddInAutomation
  45.  
  46.  
  47.     Dim strConn As String: strConn = epm.GetActiveConnection(ActiveSheet)
  48.     Dim strMem() As String
  49.     Dim strProp() As String
  50.     Dim dctMembers As Scripting.Dictionary: Set dctMembers = New Scripting.Dictionary
  51.     Dim strMemID As String
  52.     Dim lngTemp As Long
  53.     Dim lngTemp1 As Long
  54.     Dim varMemFull As Variant
  55.     Dim sngStart As Single 'PG: what if you run this at midnight!?!? :)
  56.  
  57.  
  58.    
  59.     'Get full list of dimension members with duplicates due to possible multiple hierarchies
  60.    strMem = epm.GetHierarchyMembers(strConn, "", strDim)
  61.     For lngTemp = 0 To UBound(strMem)
  62.         lngTemp1 = InStrRev(strMem(lngTemp), "[")
  63.         strMemID = Mid(strMem(lngTemp), lngTemp1 + 1, Len(strMem(lngTemp)) - lngTemp1 - 1)
  64.         'Add only unique member ID's
  65.        If Not dctMembers.Exists(strMemID) Then
  66.             dctMembers.Add strMemID, strMem(lngTemp)
  67.         End If
  68.     Next lngTemp
  69.    
  70.     ReDim strProp(0 To dctMembers.Count - 1)
  71.    
  72.     'Loop dictionary with unique member list and read strProperty Property value for XXX members
  73.  
  74.     Dim calcTEXT As String
  75.    
  76.     Dim extendEvents As Long
  77.  
  78.     sngStart = Timer
  79.    
  80.     For extendEvents = 1 To dimExtender
  81.      lngTemp = 0
  82.    
  83.     Select Case methodToCalc
  84.         Case eCalc_API
  85.                 calcTEXT = "API"
  86.                 For Each varMemFull In dctMembers.Items
  87.                     strProp(lngTemp) = epm.GetPropertyValue(strConn, CStr(varMemFull), strProperty)
  88.                     lngTemp = lngTemp + 1 'PG I think you forgot this
  89.                Next varMemFull
  90.  
  91.    
  92.         Case eCalc_Evaluate
  93.                 calcTEXT = "Evaluate"
  94.                 For Each varMemFull In dctMembers.Items
  95.                     strProp(lngTemp) = Evaluate("=EPMMEmberProperty(""" & strConn & """,""" & CStr(varMemFull) & """,""" & strProperty & """)")
  96.                     lngTemp = lngTemp + 1
  97.                 Next varMemFull
  98.  
  99.         Case eCalc_RunTime
  100.                 calcTEXT = "RunTime"
  101.                 For Each varMemFull In dctMembers.Items
  102.                     strProp(lngTemp) = Application.Run("EPMMemberProperty", strConn, CStr(varMemFull), strProperty)
  103.                     lngTemp = lngTemp + 1
  104.                 Next varMemFull
  105.                
  106.         End Select
  107.     Next extendEvents
  108.  
  109.         Debug.Print CStr(Round(Timer - sngStart, 3)) & " using " & calcTEXT & " with " & lngTemp * dimExtender & " property calculations in Dimension:" & _
  110.                 strDim & "." & strProperty
  111.  
  112.  
  113. End Sub
RAW Paste Data