Excel VBA to scap data from IBM PCOM session

Below is a simple VBA code to scrap the data from IBM PCOM session.

You need to have active IBM PCOM session and open a spreadsheet and put the below code in a Excel marco module.

The below code, collects data from "CA DETECTOR Planname Summary Display" screen for an interval. 

You can find the documentation on the objects such as PCOMM.autECLConnMgr, PCOMM.autECLOIA, PCOMM.autECLSession, PCOMM.autECLPS, PCOMM.autECLConnList 

and methods such as autECLOIAObj.SetConnectionByHandle, autECLConnList.Refresh, autECLPSObj.GetText, autECLPSObj.SetText, autECLPSObj.Sendkeys, autECLOIAObj.WaitForInputReady in the below link.

https://www.ibm.com/support/knowledgecenter/SSEQ5Y_14.0.0/com.ibm.pcomm.doc/books/html/host_access08.htm#hstlst1

Public g_row As Integer
Public autECLConnMgrObj As Object
Public autECLOIAObj As Object
Public autECLSessionObj As Object
Public autECLPSObj As Object
Public autECLConnList As Object
Public plan_list As New Scripting.Dictionary

Sub plan_display()
    
    Dim mf_txt As String
    
    If plan_list.Count > 0 Then
       plan_list.RemoveAll
    End If
    g_row = 0
    Worksheets("Sheet1").Cells.ClearContents
    
    lrow = Worksheets("plns_2_exlcude").Cells(Rows.Count, 1).End(xlUp).row 'get last non-blank row
    For i = 1 To lrow
        plan = Worksheets("plns_2_exlcude").Cells(i, 1).Value
        plan_list.Add Key:=plan, Item:=""
    Next i
    'This part creates a connection between an existing PCOMM session and Excel
    Set autECLConnMgrObj = CreateObject("PCOMM.autECLConnMgr")
    Set autECLOIAObj = CreateObject("PCOMM.autECLOIA")
    Set autECLSessionObj = CreateObject("PCOMM.autECLSession")
    Set autECLPSObj = CreateObject("PCOMM.autECLPS")
    Set autECLConnList = CreateObject("PCOMM.autECLConnList")
    autECLOIAObj.SetConnectionByHandle (autECLConnList(1).Handle)
    autECLPSObj.SetConnectionByHandle (autECLConnList(1).Handle)
    autECLConnList.Refresh
    ' end of code creates a connection between an existing PCOMM session and Excel
    
    'autECLPSObj.SetCursorPos 1, 2
    'autECLPSObj.SendKeys "tpx"
    'autECLPSObj.SendKeys "[enter]"
    'autECLOIAObj.WaitForInputReady
    
    
    x = "true"
    Do While (x = "true")
        row = 15
        For i = 1 To 9
            mf_txt = autECLPSObj.GetText(row, 2, 80)
            If Left(mf_txt, 1) = "*" Or _
               InStr(mf_txt, "BOTTOM OF DATA") > 0 Then
               x = "false"
               Exit For
            Else
              plan = Trim(Mid(mf_txt, 3, 8))
              If Not plan_list.Exists(plan) Then
                  autECLPSObj.SetText "s", row, 2
                  'autECLPSObj.Sendkeys "[enter]"
                  Call Sendkeys("[enter]")
                  Call program_display
                  'autECLPSObj.Sendkeys "[pf3]"
                  Call Sendkeys("[pf3]")
                  rowx = 1
                  mf_txt = autECLPSObj.GetText(rowx, 1, 80)
                End If
            End If
            row = row + 1
        Next i
        If x = "true" Then
            'autECLPSObj.Sendkeys "[pf8]"
            Call Sendkeys("[pf8]")
        End If
    Loop
    
End Sub

Sub program_display()
    x = "true"
    Do While (x = "true")
        row = 13
        For i = 1 To 11
            mf_txt = autECLPSObj.GetText(row, 2, 80)
            If Left(mf_txt, 1) = "*" Or _
               InStr(mf_txt, "BOTTOM OF DATA") > 0 Then
               x = "false"
               Exit For
            Else
              autECLPSObj.SetText "s", row, 2
              'autECLPSObj.Sendkeys "[enter]"
              Call Sendkeys("[enter]")
              Call sql_display
              'autECLPSObj.Sendkeys "[pf3]"
              Call Sendkeys("[pf3]")
              rowx = 1
              mf_txt = autECLPSObj.GetText(rowx, 1, 80)
            End If
            row = row + 1
        Next i
        If x = "true" Then
            'autECLPSObj.Sendkeys "[pf8]"
            Call Sendkeys("[pf8]")
        End If
    Loop
End Sub

Sub sql_display()
    x = "true"
    
    row = 4
    plan_name = autECLPSObj.GetText(row, 43, 8)
    program_name = autECLPSObj.GetText(row, 71, 8)
    
    row = 5
    pkg_type = autECLPSObj.GetText(row, 15, 8)
    
    row = 9
    int_date = autECLPSObj.GetText(row, 19, 8)
    int_time = autECLPSObj.GetText(row, 47, 8)
    
    
    Do While (x = "true")
        row = 16
        For i = 1 To 8
            mf_txt = autECLPSObj.GetText(row, 1, 80)
            If Mid(mf_txt, 2, 1) = "*" Or _
               InStr(mf_txt, "BOTTOM OF DATA") > 0 Then
               x = "false"
               Exit For
            Else
                Sql = Mid(mf_txt, 5, 8)
                Sql_stmt = Mid(mf_txt, 15, 7)
                Sql_count = Mid(mf_txt, 23, 10)
                Sql_INDB2_CPU = "'" & Mid(mf_txt, 47, 12)
                Sql_getpage = Mid(mf_txt, 60, 10)
                
                g_row = g_row + 1
                Worksheets("Sheet1").Range("A" & g_row).Value = plan_name
                Worksheets("Sheet1").Range("B" & g_row).Value = program_name
                Worksheets("Sheet1").Range("C" & g_row).Value = pkg_type
                Worksheets("Sheet1").Range("D" & g_row).Value = int_date
                Worksheets("Sheet1").Range("E" & g_row).Value = int_time
                Worksheets("Sheet1").Range("F" & g_row).Value = Sql
                Worksheets("Sheet1").Range("G" & g_row).Value = Sql_stmt
                Worksheets("Sheet1").Range("H" & g_row).Value = Sql_count
                Worksheets("Sheet1").Range("I" & g_row).Value = Sql_INDB2_CPU
                Worksheets("Sheet1").Range("J" & g_row).Value = Sql_getpage
            End If
            row = row + 1
        Next i
        If x = "true" Then
            'autECLPSObj.Sendkeys "[pf8]"
            Call Sendkeys("[pf8]")
        End If
    Loop
End Sub

Sub Sendkeys(currkey As String)
    autECLPSObj.Sendkeys currkey
    autECLOIAObj.WaitForInputReady
End Sub