Scribd Logo
Upload

Welcome to Scribd!

  • 94 views

    Recurring Instances Macro

    Uploaded by

    Poojitha Surisetti
    This VBA code extracts information about recurring report instances from a Crystal Enterprise InfoStore and writes it to an Excel spreadsheet. It loops through recurring instances, gets parent report details, path, scheduling and event information for each instance and writes it to different columns. It also calculates the total execution time and number of instances processed.

    Copyright:

    © All Rights Reserved
    Download as TXT, PDF, TXT or read online from Scribd

    Recurring Instances Macro

    Uploaded by

    Poojitha Surisetti
    94 views5 pages
    This VBA code extracts information about recurring report instances from a Crystal Enterprise InfoStore and writes it to an Excel spreadsheet. It loops through recurring instances, gets parent report details, path, scheduling and event information for each instance and writes it to different columns. It also calculates the total execution time and number of instances processed.

    Original Description:

    Recurring Instances Macro

    Copyright

    © © All Rights Reserved

    Available Formats

    TXT, PDF, TXT or read online from Scribd

    Did you find this document useful?

    Is this content inappropriate?

    This VBA code extracts information about recurring report instances from a Crystal Enterprise InfoStore and writes it to an Excel spreadsheet. It loops through recurring instances, gets parent report details, path, scheduling and event information for each instance and writes it to different columns. It also calculates the total execution time and number of instances processed.

    Copyright:

    © All Rights Reserved
    Download as TXT, PDF, TXT or read online from Scribd
    Download as txt, pdf, or txt
    94 views5 pages

    Recurring Instances Macro

    Uploaded by

    Poojitha Surisetti
    This VBA code extracts information about recurring report instances from a Crystal Enterprise InfoStore and writes it to an Excel spreadsheet. It loops through recurring instances, gets parent report details, path, scheduling and event information for each instance and writes it to different columns. It also calculates the total execution time and number of instances processed.

    Copyright:

    © All Rights Reserved
    Download as TXT, PDF, TXT or read online from Scribd
    Download as txt, pdf, or txt
    of 5

    Private Sub cbExtract_Click()

    Application.ScreenUpdating = True
    Dim ModeRecalcul As Long
    ModeRecalcul = Application.Calculation
    Application.Calculation = xlCalculationAutomatic
    Application.EnableEvents = False
    'Purge existing data
    Sheets("Recurring Instance List").Range("A3:L65000").ClearContents
    'Session Manager declaration
    Dim SessionManager, Sess As SessionMgr
    'Enterprise Session declaration
    Dim esession As EnterpriseSession

    Dim i, j, k, x, intEventCount As Integer


    Dim BenchMark As Double
    Dim iStore As InfoStore
    'Info Objects declaration
    Dim Rs As InfoObjects
    'Rpt Object declaration
    Dim Rng As Excel.Range
    Dim RowNum As Long
    '---Vars for path--
    Dim Path As String
    Dim ParentFolderID
    Dim tempObj
    '---Vars for instance count and runtime--
    Dim intCounter As Integer
    Dim runtimetotal
    Dim runtime
    Dim rsRow2
    Dim rsRow
    '---Vars for processing info---
    Dim oProcessingInfo As CrystalInfoStoreLib.ProcessingInfo
    Dim ParamNum As Integer
    Dim strParamName, strParamValue, strParamList As String
    '---Vars for ScheduleInfo----
    Dim oScheduleInfo As CrystalInfoStoreLib.SchedulingInfo
    Dim strEventID, strEventName, strEventList, strEventNum As String
    '----------------------------
    On Error GoTo ErrorHandler
    Dim ErrorState As String

    'Session Manager instanciation


    Set SessionManager = CreateObject("CrystalEnterprise.SessionMgr")
    'Enterprise Session instanciation
    Set esession = SessionManager.Logon(tbName, tbPassword, tbCMS, "secEnterpris
    e")
    'Infostore instanciation
    Set iStore = esession.Service("", "InfoStore")
    'Document the reports
    BenchMark = Timer

    'Set the starting Excel row number


    RowNum = 2
    Set Rng = Sheets("Recurring Instance List").Cells
    'Write in the top the server/login used, the update date
    Rng(1, 4) = "Server: " & tbCMS & Chr(10) & "User: " & tbName & Chr(10) & "Up
    date Date: " & Date
    Rng(1, 5) = RowNum - 2
    'For i = 3 To 3 'Set to FC only

    '--Select ALL Recurring Instances-----------------------------------------------


    -
    Set Rs = iStore.Query("SELECT TOP 50000 * FROM CI_INFOOBJECTS WHERE SI_INSTANCE
    = 1 AND SI_RECURRING = 1 ORDER BY SI_ID ASC")
    '--------------------------------------------------

    For Each rsRow In Rs 'LOOP1 RECURRING INSTANCES

    Set tempObj = iStore.Query("SELECT * FROM CI_INFOOBJECTS WHERE SI_ID = " & r


    sRow.Properties("SI_PARENTID") & " AND SI_INSTANCE = 0")
    For Each rsRow2 In tempObj 'LOOP2 Parent reports of recurring instances

    RowNum = RowNum + 1
    Rng(1, 5) = RowNum - 2
    Rng(RowNum, 1) = Mid(rsRow2.Properties("SI_PROGID"), 19, Len(rsRow2.Prop
    erties("SI_PROGID")))
    Rng(RowNum, 2) = rsRow2.Properties("SI_ID")
    Rng(RowNum, 3) = rsRow2.Properties("SI_NAME")
    Rng(RowNum, 4) = rsRow2.Properties("SI_UPDATE_TS")
    Rng(RowNum, 5) = rsRow2.Properties("SI_CREATION_TIME")
    '------------------------------------------------------------------------
    'Get the Path
    '------------------------------------------------------------------------
    ParentFolderID = rsRow2.ParentID
    Set tempObj = iStore.Query("SELECT SI_ID, SI_NAME, SI_PARENTID FROM CI_INFOO
    BJECTS WHERE SI_ID=" & ParentFolderID)
    ParentFolderID = tempObj.Item(1).ParentID
    Path = "/" + tempObj.Item(1).Title + Path
    Do While ParentFolderID <> 0 And ParentFolderID <> 4
    Set tempObj = iStore.Query("SELECT SI_PATH, SI_NAME FROM CI_INFOOBJECTS
    WHERE SI_ID=" & ParentFolderID)
    Path = "/" + tempObj.Item(1).Title + Path
    ParentFolderID = tempObj.Item(1).ParentID
    Loop
    Path = "Home" & Path
    Rng(RowNum, 6) = Path
    Path = ""
    Rng(RowNum, 7) = rsRow.Properties("SI_ID")
    Rng(RowNum, 8) = rsRow.Properties("SI_NAME")
    '-----------------------------------------------
    'Get the prompt info
    '---Turned off in this version-----
    '---------------------------------------------

    ' Set oProcessingInfo = rsRow2.ProcessingInfo


    ' If oProcessingInfo.Properties("SI_HAS_PROMPTS").Value = True Then
    ' ParamNum = oProcessingInfo.Properties("SI_FULLCLIENT_PROMPTS").Properti
    es("SI_TOTAL").Value
    ' If ParamNum = 1 Then
    ' lstParams = oProcessingInfo.Properties("SI_FULLCLIENT_PROMPTS").Pro
    perties(1).Properties("SI_NAME").Value & ": " & oProcessingInfo.Properties("SI_
    FULLCLIENT_PROMPTS").Properties(1).Properties("SI_VALUES").Properties("1").Value
    ' Else
    ' For j = 1 To ParamNum
    ' strParamName = oProcessingInfo.Properties("SI_FULLCLIENT_PROMPT
    S").Properties(j + 1).Properties("SI_NAME").Value
    ' strParamValue = oProcessingInfo.Properties("SI_FULLCLIENT_PROMP
    TS").Properties(j + 1).Properties("SI_VALUES").Properties("1").Value
    ' strParamList = strParamList & Chr(10) & (strParamName & ": " &
    strParamValue)
    ' Next j
    '
    ' End If
    ' End If
    ' Rng(RowNum, 9) = Mid(strParamList, 2, Len(strParamList))
    ' strParamList = ""
    '

    '----Go get Event info----------------------------------------------------------


    ------
    '----I have to account for the possibility of multiple events and so a loop is n
    ecessary-------
    Set oScheduleInfo = rsRow.SchedulingInfo
    Rng(RowNum, 9) = oScheduleInfo.Properties("SI_SUBMITTER").Value

    intEventCount = oScheduleInfo.Properties("SI_DEPENDENCIES").Properties("SI_TOTA
    L").Value

    If intEventCount >= 1 Then

    For x = 1 To intEventCount
    strEventNum = x
    tempObj = iStore.Query("SELECT SI_NAME FROM CI_SYSTEMOBJECTS WHERE SI_
    ID=" & oScheduleInfo.Properties("SI_DEPENDENCIES").Properties(strEventNum).Value
    )
    strEventName = tempObj.Properties("SI_NAME").Value
    strEventList = strEventList & strEventName & Chr(59)
    Next x
    Rng(RowNum, 10) = strEventList
    strEventList = ""
    Else
    'Do Nothing
    End If
    intEventCount = 0
    '---Obtain destination email addresses:
    If oScheduleInfo.Properties("SI_DESTINATIONS").Properties("SI_TOTAL").Value =
    1 Then
    '-----------------
    If oScheduleInfo.Properties("SI_DESTINATIONS").Properties("1").Propertie
    s("SI_PROGID") = "CrystalEnterprise.Smtp" Then
    Rng(RowNum, 11) = oScheduleInfo.Properties("SI_DESTINATIONS").Proper
    ties("1").Properties("SI_DEST_SCHEDULEOPTIONS").Properties("SI_MAIL_ADDRESSES").
    Properties("1").Value
    Else
    'Do nothing
    End If
    '-----------------
    Else
    'Do Nothing
    End If

    '---Get output path-------------------------------------------------------------


    ---------------------
    '---Turned off in this version-----
    ' If oScheduleInfo.Properties("SI_DESTINATIONS").Properties("SI_TOTAL").Value =
    1 Then
    ' '-----------------
    ' If oScheduleInfo.Properties("SI_DESTINATIONS").Properties("1").Properti
    es("SI_PROGID") = "CrystalEnterprise.DiskUnmanaged" Then
    ' Rng(RowNum, 12) = oScheduleInfo.Properties("SI_DESTINATIONS").Prope
    rties("1").Properties("SI_DEST_SCHEDULEOPTIONS").Properties("SI_OUTPUT_FILES").P
    roperties("1").Value
    '
    ' Else
    ' 'Do nothing
    ' End If
    ' '-----------------
    ' Else
    ' 'Do Nothing
    ' End If
    '--Get the output type----------------------------
    Rng(RowNum, 12) = rsRow.Properties("SI_KIND")
    '------------------------------------------------------------------------
    txtCount.Value = "Instances: " & RowNum - 2
    Me.Repaint

    '------------------------------------------------------------------------
    Next rsRow2
    Next rsRow
    '------------------------------------------------------------------------
    'Next i
    '------------------------------------------------------------------------
    Rng(1, 6) = "Last Execution Duration (min/sec): " & (Timer - BenchMark) / 60
    Application.Calculation = ModeRecalcul
    Calculate
    Application.Calculation = xlCalculationManual
    Application.EnableEvents = True
    Me.Hide
    CleanUp:
    Me.Hide
    On Error Resume Next
    esession.Logoff
    Application.Calculation = ModeRecalcul
    Calculate
    Application.EnableEvents = True
    Exit Sub
    ErrorHandler:
    'Debug.Print Err.Number & " - " & Err.Description
    If Err.Number = -2147210697 Then
    'Debug.Print Err.Number & " - " & Err.Description
    If ErrorState = "FullName" Then Rng(RowNum, 3) = "Error on Full Name"
    If ErrorState = "LastLogon" Then Rng(RowNum, 9) = ""
    Resume Next
    End If
    Me.Hide
    MsgBox Err.Source & " - " & Err.Number & ": " & Err.Description & " " & Err
    .HelpContext, _
    vbCritical, "Failure in UsersGroups()"

    Resume CleanUp
    End Sub

    Private Sub txtCount_Change()


    End Sub
    Private Sub UserForm_Click()
    End Sub

    You might also like