Copy data from Attachmate to Excel in a Loop to a single cell in each sheet

[Tommeck37]

Hello,

I am trying to build up a big macro tool to automate process of reporting.

I have a three-days report to scrape off the screen of attachmate. I'd like to create a code that would go into session, scrape specific data from specific line of screen and paste it onto excel sheet (to each sheet, cell B10). The thing that makes it more complex is that macro has got to go into session by three parameters
1. it puts string "S" on screen
2. takes data from cell I5 and puts on the screen lines below
3. takes date from the last sheet cell A1 and puts onto screen then goes into session by sending "enter"

With the above three items it enters session and copies data. It should enter session with the above datas as many times as there are sheets in excel (with data in I5). Then it should paste the financial figure into each sheet (from which data from 2. was taken to enter session) to cell B10.

The so far code goes in to session. I am not able to copy any data to cell B10 let alone make it a loop.

Please find the excel with code attached below.

Thank you for any help

Tommeck37

 

[Tommeck37]

The cursor resides in 1, 1 position

 

[SkipVought]

Okay, here's how I see it...

Sub RapidBalances()

    Dim Sys As Object, Sess As Object, Screen As Object
    Dim i As Integer
    Dim lRow As Long, rw As Integer
        
    Set Sys = CreateObject("EXTRA.System")
    
    
    
    ' Assumes an open session
    Set Sess = Sys.ActiveSession
    Set Screen = Sess.Screen
    
    'Enters a today's date minus one day for statement date to input into sys session
    
    ThisWorkbook.Sheets("Day1").Range("A1") = WorksheetFunction.Text(Now() - 1, "ddmmyyyy")
    dzien = Sheets("Day1").Range("A1").Value
    'Copies content of cell in order to have value date of a month
    
'this value never changes so why should if be in the loop???
    miesiac = ThisWorkbook.Sheets("Day1").Range("A2").Value
            
    'Loop for all sheets to take value of cell I5 to enter into sys session
    For i = 1 To ThisWorkbook.Sheets.Count
        gdzie = ThisWorkbook.Sheets(i).Range("I5").Value
        
        
        On Error Resume Next

'
        Screen.PutString "S", 5, 20
        Screen.PutString "     ", 13, 49
        Screen.PutString gdzie, 13, 49
        Screen.PutString dzien, 20, 51
        Screen.SendKeys ("<enter>")
        
'these coordinates are a guess from your jpg
'the cursor appears to be in screen location 1,1
'this is odd to me, but your system seems a bit odd from the ones I've seen at three aerospace companies over 30 years
        Do Until Sess.Screen.WaitForCursor(1, 1) Or Sess.Screen.GetString(23, 16, 14) = "NO INFORMATION"
            DoEvents
        Loop
      
        
        If Sess.Screen.GetString(23, 16, 14) <> "NO INFORMATION" Then   'prosess summary screen
            
            lRow = Application.CountA(ThisWorkbook.Sheets(i).Range(Cells(10, "C"), Cells(30, "C"))) + 1
            
            rw = 12  'whatever screen row
            Do Until Trim(GetString(rw, 9, 8)) = "" Or rw > 23   'when the date is EMPTy whatever column that is
               ThisWorkbook.Sheets(i).Cells(10 + lRow, "C").Value = Trim(GetString(rw, 22, 23)) * -1
               ThisWorkbook.Sheets(i).Cells(10 + lRow, "D").Value = "cr val" & GetString(rw, 9, 8)
               
               lRow = lRow + 1     'incriment the sheet row
               ThisWorkbook.Sheets(i).Cells(10 + lRow, "C").Value = Trim(GetString(rw, 47, 23)) * 1
               ThisWorkbook.Sheets(i).Cells(10 + lRow, "D").Value = "db val" & GetString(rw, 9, 8)
               
               lRow = lRow + 1     'incriment the sheet row
               rw = rw + 1         'incriment the screen row
            Loop
        
            
            Screen.SendKeys "<PF3>"
            Do Until Sess.Screen.WaitForCursor(5, 20)  'coordinates for the initial screen
                DoEvents
            Loop
        End If
        
'now get another sheet
    Next i
End Sub

 

[Tommeck37]

good job

the issues are still there

1. Loop goes sheet by sheet, however, when it finds a bank that cannot open summary screen it waits as long as precisely 30 seconds, that gives a lot of time
2. the time to copy figures from the screen I think is too short as macro did not copy those banks that have many items (debits and credits)
3. macro copies only debits (only line rw, 31, 17, but should also rw, 58, 17
4. macro copies to spreadsheet C10 and on, but...it goes to next below cells in the next sheet, so when macro reached 40th sheet (as there are around 60) the figures were then copied outside the table. It should copy from C10 and below and restart on next sheet again from C10 not C11 on next sheet
5 the last problem but not least is decision making, there is no decision as to which figures to copy, it copies all if so
I need a decision if value date is > than current month then copy figures (debits and credits) otherwise do not copy anything

I think you are close to perfect solution just those 5 points need adjustment

Kind Regards,
Tommeck37

 

[SkipVought]

1. "waits precisely 30 seconds"

How can that be? I have no precise wait ANYWHERE in my code!

 

[Tommeck37]

I can confirm, there is no waiting time at all, let alone precisely 30 sec.

Odd it is

 

[SkipVought]

Well then I don't understand problem 1.

Please explain so that it is clear.

 

[Tommeck37]

when it gets to sheet which there is no information in below line, then it waits that time for 30 seconds
why? do not know

why 30sec not 10sec I could ask or why not an hour? when it runs nothing specific happens on the screen

this is the culprit

Do Until Sess.Screen.WaitForCursor(1, 1) Or Sess.Screen.GetString(23, 16, 14) = "NO INFORMATION"
            DoEvents
        Loop

Nothing happens on the initial screen then it takes another sheet and gets inside swiftly until it stops again on the bank that has no summary screen


Kind Regards

 

[SkipVought]

Lets go step by step here.

What's the bank code where this happens? We want to set up a test situation where we can look at this case in isolation.

The initial screen is loaded with S, the bank code and the date string, correct?

Then ENTER is sent.

Now the code is in a loop waiting until the cursor rests at 1,1 (on the summary screen) or until "NO INFORMATION" at 23,16 on the initial screen, correct?

Please answer these three questions.

 

[Tommeck37]

The first bank that has no summary screen is from sheet 80012

Answer for second question is yes
Then enter is sent

For the last question I am not sure as Icannot tell it really rests in 1, 1 I cannot see it rest anywhere. No cursor is visible then

 

[SkipVought]

no cursor is visible? Then what about the cursor coordinates at Lower RH corner?

 

[Tommeck37]

when I executed step by step

Do Until Sess.Screen.WaitForCursor(1, 1) Or Sess.Screen.GetString(23, 16, 14) = "NO INFORMATION"
            DoEvents
        Loop

I do not see the cursor, if it cannot enter summary screen; letters S, bank name, and date get red and the initial screen stands still. I am not able to trace anything that lets the macro continue with the next bank

I think we confused rest position 1, 1 with summary screen. This position (1, 1 ) relates to summary screen.
The rest position for initial screen is (5, 20) it is where the letter S is positioned.
I've tried to exchange 1, 1 in code with 5, 20 but the result is even worse. The macro got inside of summary screen and stopped there or waitied for so long that I took it as if it stopped.

Kind Regards,

Tommeck37

 

[SkipVought]

Here's the deal: either the screen goes to summary, where 1,1 are the rest coordinates, OR there is a mInframe error and it stays on initial...

...in which case the MESSAGE is posted in 23,16, correct?

So what's happeneng there? You have not said anything about the message.

 

[Tommeck37]

yes, when bank is empty there is system error and it stops, font gets red...

then there is message below "NO INFORMATION FOUND ***" but this you already know

 

[SkipVought]

So does that message appear 'immediately'?

 

[Tommeck37]

yes, at once

In the meantime I checked with my code and it has resolved one issue of the two I had. Now it is only one issue to resolve.
The problem is that all data is copied to specific cell not taking into account the fact that it can already be non-empty.

My question is if it is possible to modify the below code so that it copies figures and sentences to first empty cell counting from C10 and D10 and below?


Here is the code

Sub RapidBalances()
Dim Sys As Object, Sess As Object, Screen As Object
Dim i As Integer
    Set Sys = CreateObject("EXTRA.System")



' Assumes an open session
    Set Sess = Sys.ActiveSession
        Set Screen = Sess.Screen

'Enters a today's date minus one day for statement date to input into sys session

'ThisWorkbook.Sheets("Day1").Range("A1") = WorksheetFunction.Text(Now() - 1, "ddmmyyyy")
dzien = Sheets("Day1").Range("A1").Value
        
'Loop for all sheets to take value of cell K5 to enter into sys session
For i = 1 To ThisWorkbook.Sheets.Count - 1
gdzie = ThisWorkbook.Sheets(i).Range("I5").Value
On Error Resume Next
Do

'With Session

       Screen.PutString "S", 5, 20
       Screen.WaitHostQuiet (10)
       Screen.MoveTo 13, 49
       Screen.SendKeys "<EraseEOF>"
       Screen.PutString gdzie, 13, 49
       Screen.WaitHostQuiet (10)
       Screen.PutString dzien, 20, 51
       Screen.WaitHostQuiet (10)
       Screen.SendKeys ("<enter>")
       Screen.WaitHostQuiet (100)
       If Sess.Screen.getstring(23, 16, 14) = "NO INFORMATION" Then Exit Do
       If Sess.Screen.getstring(12, 13, 2) < 2 Then
       ThisWorkbook.Sheets(i).Range("C10").Value = Sess.Screen.getstring(12, 31, 17) * -1
       If Trim(Sess.Screen.getstring(12, 13, 2)) = "" Then Exit Do
       ThisWorkbook.Sheets(i).Range("D10").Value = "cr val" & Sess.Screen.getstring(12, 10, 8) & " on stt" & dzien
       ThisWorkbook.Sheets(i).Range("C11").Value = Sess.Screen.getstring(12, 58, 17)
       ThisWorkbook.Sheets(i).Range("D11").Value = "db val" & Sess.Screen.getstring(12, 10, 8) & " on stt" & dzien
       End If
       Screen.WaitHostQuiet (1000)
       If Sess.Screen.getstring(13, 13, 2) < 2 Then
       ThisWorkbook.Sheets(i).Range("C12").Value = Sess.Screen.getstring(13, 31, 17) * -1
       If Trim(Sess.Screen.getstring(13, 13, 2)) = "" Then Exit Do
       ThisWorkbook.Sheets(i).Range("D12").Value = "cr val" & Sess.Screen.getstring(13, 10, 8) & " on stt" & dzien
       ThisWorkbook.Sheets(i).Range("C13").Value = Sess.Screen.getstring(13, 58, 17)
       ThisWorkbook.Sheets(i).Range("D13").Value = "db val" & Sess.Screen.getstring(13, 10, 8) & " on stt" & dzien
       End If
       Screen.WaitHostQuiet (1000)
       Screen.WaitHostQuiet (50)
       Screen.SendKeys "<PF3>"
       Screen.WaitHostQuiet (10)

    
    
Loop Until True
Next i
    'End With
End Sub

The only thing missing is making code to copy data to first empty cell starting from C10 and D10 in paralel.

I am enclosing the file I have managed so far.

 

[SkipVought]

Strange, that now there is but one issue.

Your Do...Loop includes the initial screen and the summary screen. WHY?

The only thing that needs to loop are rows 12-22 in the summary as I posted in my code. You have removed the rw counter for those screen and the lRow counter for the sheet.

What's going on?

 

[Tommeck37]

The thing is that I do not fully understand your code.
For your code there are still 5 problems

My old code is not perfect, but almost does the necesarry job with the exception that it always copies to the specific cells. The problem comes when I have to run the process again with different date for initial screen. Then the cells will already be filled in with data so the new one will overwrite those and that' useless.

I would utilize your code for copying to next empty cell from C9 but it copies incorrectly as it goes with the next cell on the next sheet while it should restart from C9 and D9. and not C11 and D11.


Regards
Tommeck37

 

[SkipVought]

I have corrected that small glitch.

I was referring to problem 1. If that is not solved, then we cannot proceed.

        Do Until Sess.Screen.WaitForCursor(1, 1) Or Sess.Screen.GetString(23, 16, 14) = "NO INFORMATION"
            DoEvents
        Loop

 

[Tommeck37]

I have corrected that small glitch.

What are you referring to?

For the problem no. 1 I myself have no idea what to do. I have no idea of function "WaitForCursor" What is the idea behind that?

Regards

 

[SkipVought]

Sorry, the small glitch was in regard to the cell reference ib the sheet. But as I implied, that's minor with respect to screen navigation, which must be perfected before the contents are scrapped and transfered to any other system.

More importantly, it seem you have ignored lots that i have put forward, including what WaitForCursor does.

So you can have a go at it yourself, as you appear to discount my suggestions.