Introduction

This post leads on from the foundations created in Part 1 and 2 but most of the code stands by itself but leverages the Config sheet for instances and credentials.   If you have not gone through Part 1 and 2, please do so before starting Part 3 to familiarise yourself with the concepts.

The objective in this post is to allow you to work with processes: Getting, Putting and Patching. The code retrieves a whole process and promotes it a specified server.  This is a really useful piece of code to have and I use it very frequently to promote Processes from a development environment to quality then production.

Also useful when setting up a new instance and needing to copy over your library of Processes.

The concepts covered can be explored further to update certain components of a TI process individually  if required. That will be left as an exercise to the reader.

There are numerous other enhancements that could be added to better handle errors, alerts etc. etc. I have tried to cut down the code to the minimum to get to a working solution. Code may be a bit rustic in places so any feedback on doing things better is always welcome.

Let’s get going!

1. Overview of the Promote Process activities

Build a form that will allow for the following:

• Select a Source server (based on your PAfE connections)
• Select a Database from the Source server
• Display all Source Processes
• Select one or more Processes
• Select a Target server (based on your PAfE connections)
• Select a Database from the Source server
• Display all Target Processes
• Promote selected Processes from Source to Target database
  • Put new processes
  • Patch existing processes

2. Creating the User Form to drive the Process

Create a new form based on the below screenshot with close attention on the naming to avoid issues later.

Source Database and Target Database are frames I added first then added the necessary object to each frame.

Update the lstSrcTIProcesses MultiSelect property to 1 to allow multiple selection.

3. Adding the code to drive the combos and list boxes

3.1. Form Activation

We read our connections from the Config sheet. 

Private Sub UserForm_Activate()

    'Read Connections from our configuration sheet and update the drop down

    'Check that you have a named range on your config for Connections - Should go from Connection to Token column

    'Using the Unique function – older Excel versions may not support
    Dim arrConnections As Variant
    arrConnections = Application.WorksheetFunction.Unique(Sheets("Config").Range("Connections").Columns(2).Value)


    cboSrcConnectionURL.List = arrConnections
    cboTgtConnectionURL.List = arrConnections

End Sub

 
3.2.      Fill Database combo boxes with servers

When the connection changes we need to get the available Source databases

Private Sub cboSrcConnectionURL_Change()

    'Connections Range is on the Config sheet - B13:H34


    Dim strSrcConnectionURL As String
    Dim i As Integer
    Dim currSheets As Worksheet
    Dim arrDatabases As Variant

    strSrcConnectionURL = Me.cboSrcConnectionURL.Value

    'Get available servers based on selected source URL
    Set currSheet = ActiveSheet
    Sheets("Config").Activate
    arrDatabases = Application.WorksheetFunction.Filter(Range(Sheets("Config").Range("Connections").Columns(2), Sheets("Config").Range("Connections").Columns(3)), _

    Evaluate(Sheets("Config").Range("Connections").Columns(2).Address & "=""" & strSrcConnectionURL & """"), "No Servers")

    currSheet.Activate

    'Add to our combo box
    cboSrcDatabase.Clear

    For i = 1 To UBound(arrDatabases)
        cboSrcDatabase.AddItem arrDatabases(i, 2)
    Next

End Sub

Similarly for Target databases

Private Sub cboTgtConnectionURL_Change()

    Dim strTgtConnectionURL As String
    Dim i As Integer
    Dim currSheets As Worksheet
    Dim arrDatabases As Variant

    strTgtConnectionURL = Me.cboTgtConnectionURL.Value

    Set currSheet = ActiveSheet
    Sheets("Config").Activate

    'Get available servers based on selected source URL
    arrDatabases = Application.WorksheetFunction.Filter(Range(Sheets("Config").Range("Connections").Columns(2), Sheets("Config").Range("Connections").Columns(3)), _

    Evaluate(Sheets("Config").Range("Connections").Columns(2).Address & "=""" & strTgtConnectionURL & """"), "No Servers")

    currSheet.Activate

    cboTgtDatabase.Clear
    For i = 1 To UBound(arrDatabases)
        cboTgtDatabase.AddItem arrDatabases(i, 2)
    Next

End Sub

 
3.3.      Fill list boxes with available Processes

Read the Processes from the Source Database:

Private Sub cboSrcDatabase_Change()
    Dim strSrcDatabase As String
    Dim oProcesses As Variant
    Dim oProcess As Variant
    Dim pQueryString As String

    'Get Processes from the Database in our Connection
    pQueryString = "Processes?$select=Name"

    Set oProcesses = ExecuteQueryTI("Get", cboSrcConnectionURL, cboSrcDatabase, pQueryString, True)

    'Add Processes to the combo box
    lstSrcTIProcesses.Clear
    For Each oProcess In oProcesses("value")
        lstSrcTIProcesses.AddItem oProcess("Name")
    Next

End Sub

Read the Processes from the Target Database:

Private Sub cboTgtDatabase_Change()
    Dim strTgtDatabase As String
    Dim oProcesses As Variant
    Dim oProcess As Variant
    Dim pQueryString As String

    pQueryString = "Processes?$select=Name"
    Set oProcesses = ExecuteQueryTI("Get", cboTgtConnectionURL, cboTgtDatabase, pQueryString, True)

    lstTgtTIProcesses.Clear
    For Each oProcess In oProcesses("value")
        lstTgtTIProcesses.AddItem oProcess("Name")
    Next

End Sub

 
3.4.      Copy in code to do the Get, Put and Patch

This code is similar to what was used in Part 1 and Part 2 but extended to work with a payload and a flag to tell the function to convert JSON to a dictionary or not. You may need to retrofit  prior functions otherwise leave as two separate functions.

Function ExecuteQueryTI(pAction As String, pConnection As String, pDatabase As String, pQueryString As String, Optional bConvertJSON As Boolean, Optional strPayload As String) As Object

    Dim TM1Service As New MSXML2.XMLHTTP60
    Dim pUsername As String
    Dim pPassword As String
    Dim pCAMNamespace As String
    Dim arr As Variant
    Dim iDB As Integer
    Dim currSheet As Worksheet
    Dim sBase64Credentials As String
    Dim sQueryString As String
    Dim sQueryResult As String
    Dim bAsynch As Boolean

    Set currSheet = ActiveSheet
    Sheets("Config").Activate

    'Lookup Username and Passwords from selection connection and database
    arr = Application.WorksheetFunction.Filter(Sheets("Config").Range("Connections"), _

    Evaluate(Sheets("Config").Range("Connections").Columns(2).Address & "=""" & pConnection & """"), _

             "No Servers")

    For iDB = 1 To UBound(arr)
        If (arr(iDB, 3)) = pDatabase Then
            pUsername = arr(iDB, 4)
            pPassword = arr(iDB, 5)
            pCAMNamespace = arr(iDB, 6)
        End If
    Next

    sBase64Credentials = Base64Encode(pUsername & ":" & pPassword & ":" & pCAMNamespace)

    With TM1Service
            sQueryString = pConnection & "tm1/api/" & pDatabase & "/api/v1/" + pQueryString

            pAction = UCase(pAction)
            If pAction = "POST" Or pAction = "PATCH" Then
               bAsynch = True
            Else
               bAsynch = False
            End If

            .Open pAction, sQueryString, bAsynch
            .setRequestHeader "Content-Type", "application/json"
            .setRequestHeader "Accept", "application/json;odata.metadata=none"
            .setRequestHeader "TM1-SessionContext", "TM1 REST API tool"
            .setRequestHeader "Authorization", "CAMNamespace " & sBase64Credentials
            .Send strPayload

            While .readyState <> 4
                DoEvents
            Wend

            If .Status >= 400 And .Status <= 599 Then
                sQueryResult = CStr(.Status) + " - " + .statusText
                If .responseText <> "" Then
                    sQueryResult = sQueryResult + vbCrLf & .responseText
                End If

                MsgBox "Error " + sQueryResult, vbCritical, "Connection"
                GoTo Cleanup
            End If

        sQueryResult = .responseText
        Debug.Print sQueryResult

    End With

    If sQueryResult <> "" Then
        If bConvertJSON <> False Then
            Set ExecuteQueryTI = JsonConverter.ParseJson(sQueryResult)
        Else
            Set arr = New Collection
            arr.Add sQueryResult
            Set ExecuteQueryTI = arr
        End If
    Else
        Set ExecuteQueryTI = Nothing
    End If

Cleanup:

End Function

 
3.5.      Promote the selected Processes

There are potentially better ways of checking if a process exists but this code basically tried to retrieve all processes filtered by the selected name. If nothing is returned, process does not exist. An alternative would be to simply compare to the Target process list.

When a Process does not exist, we need to use a PUT to create it.

Where a Process already exists, we need to use a PATCH to update/overwrite it.

There seems to be an issue trying to PATCH where a Process has attributes like Caption. The PATCH always seems to fail. For now and until I know better, the code removes the Attributes section from the JSON before patching.

Private Sub cmdPromote_Click()

Dim TM1Object As String
Dim pQueryString As String
Dim srcProcess As String
Dim lstProcess As Variant
Dim oPayload As Variant
Dim oDataResponse As Variant
Dim strPayload As String
Dim strTargetProcess As Variant
Dim iIndex As Integer
Dim iTargetIndex As Integer
Dim bProcessExists As Boolean
Dim strMessage As String

Application.ScreenUpdating = False

'=====LOOP THROUGH AND PROCESS SELECTED ITEMS=====
strMessage = ""
For iIndex = 0 To Me.lstSrcTIProcesses.ListCount - 1
    If Me.lstSrcTIProcesses.Selected(iIndex) Then
        srcProcess = Me.lstSrcTIProcesses.List(iIndex)

        '=====SOURCE SERVER=====
        pQueryString = "Processes('" & srcProcess & "')"
        Set oPayload = ExecuteQueryTI("GET", cboSrcConnectionURL, cboSrcDatabase, pQueryString, False)
        strPayload = oPayload(1)
       

        '=====TARGET SERVER=====
        '-----Check if the target process already exists using the REST API-----
        bProcessExists = False
        pQueryString = "Processes?$filter=Name eq '" & srcProcess & "'&$select=Name"
        Set oDataResponse = ExecuteQueryTI("GET", cboTgtConnectionURL, cboTgtDatabase, pQueryString, True)

        If oDataResponse("value").Count > 0 Then
            bProcessExists = True
        End If

        '--You could also look in the target list for a match
        'For iTargetIndex = 0 To lstTgtTIProcesses.ListCount - 1
            'If lstTgtTIProcesses.List(iTargetIndex) = srcProcess Then
                'bProcessExists = True
            'End If
        'Next


        '-----Patch if process exists otherwise Put if it is new-----
        pQueryString = "Processes('" & srcProcess & "')"
        If bProcessExists Then
            '--Cannot Patch where Attributes exist
            '--For now Caption looks to be at the end of the payload so removing attributes

            iTargetIndex = InStr(1, strPayload, """Attributes"":", vbTextCompare)
            If iTargetIndex > 0 Then
                strPayload = Left(strPayload, iTargetIndex - 2) & "}"
            End If

            Set oDataResponse = ExecuteQueryTI("PATCH", cboTgtConnectionURL, cboTgtDatabase, pQueryString, False, strPayload)
        Else
            Set oDataResponse = ExecuteQueryTI("PUT", cboTgtConnectionURL, cboTgtDatabase, pQueryString, False, strPayload)
        End If

        If InStr(1, oDataResponse(1), srcProcess) > 0 Then
            strMessage = strMessage + srcProcess & " -> Success" & vbCrLf
        Else
            strMessage = strMessage + srcProcess & " -> FAILED" & vbCrLf
        End If
    End If
Next
 

'--Rebuild the Target List
Call cboTgtDatabase_Change
Application.ScreenUpdating = True


'--Message on completion - showing last item
MsgBox strMessage, vbOKOnly, "Promotion to " + tgtServer


End Sub

 
3.6.      Close the form

I am just hiding the form when closing it. You may want to unload etc. but hide should remember your selection if you run the form again without having closed the book.

Private Sub cmdClose_Click()
    Me.Hide
End Sub

 
3.7.      Add a command button to show the form

You can add a button on a new sheet or on Config and link to the following code:

Sub TIPromote()
    ufTIPromote.Show
End Sub

4. Testing

Confirm that the Config sheet has the necessary columns with the values for each column e.g.

Assuming all the copying and pasting has worked and the object names are as expected, you should be able to run the form by clicking the command button you just added.

Select a Source Connection URL then a Database to populate the list of source processes.

Do the same for your Target Connection URL and Database.

Select one or more Processes from the source list then click Promote to promote to the target Database.

Assuming all is correct in the code and form, you should receive a message box listing the Processes promoted.

5.   Summary

You should now have some code to allow you to Put and Patch processes.

The code introduced should allow you to enhance what was built and adapt to various scenarios you may have.

Further enhancements could be undertaken to read from the Connections file that PAfE uses if you do not want to use the Config sheet and store passwords in the file.

You could also enhance allow copying from either Database to the other or add buttons to allow you to delete selected Processes.

As always, please let me know if you find this useful, find any gremlins or have other comments in general.