Incorperating a Screenscrape into a Do Loop 2

[brumo]

Instead of writing an If statement for every row, isn't there a better way of coding this:

Sub Main()

  Dim Sys As Object,Sess As Object,xl as Object,wb as Object
  Set Sys = CreateObject("EXTRA.System")
  Set Sess = Sys.ActiveSession
  Set xl = CreateObject("Excel.Application")
  Set wb = xl.Workbooks.Open("c:\_excel ccmbalance.xlsx")

  Do
    EndCheck = Sess.Screen.WaitForString("USSMSG10")
      If Not EndCheck then
        Sess.Screen.SendKeys "<Pf8>"
      End If
  Loop Until EndCheck
        
    AmtCheck = trim(Sess.Screen.GetString( 1, 10, 22))
      If AmtCheck = "A VM001 - VM/SP" then
        AmtVaule = trim(Sess.Screen.GetString( 1, 10, 50))
          wb.WorkSheets("Sheet1").Cells(11, "H").Value = AmtValue
            End If
    AmtCheck = trim(Sess.Screen.GetString( 2, 10, 22))
      If AmtCheck = "A VM001 - VM/SP" then
        AmtValue = trim(Sess.Screen.GetString( 2, 10, 50))
          wb.WorkSheets("Sheet1").Cells(11, "H").Value = AmtValue
            End If  
    AmtCheck = trim(Sess.Screen.GetString( 3, 10, 22))
      If AmtCheck = "A VM001 - VM/SP" then
        AmtValue = trim(Sess.Screen.GetString( 3, 10, 50))
          wb.WorkSheets("Sheet1").Cells(11, "H").Value = AmtValue
            End If
    AmtCheck = trim(Sess.Screen.GetString( 4, 10, 22))
      If AmtCheck = "A VM001 - VM/SP" then
        AmtValue = trim(Sess.Screen.GetString( 4, 10, 50))
          wb.WorkSheets("Sheet1").Cells(11, "H").Value = AmtValue
            End If
    AmtCheck = trim(Sess.Screen.GetString( 5, 10, 22))
      If AmtCheck = "A VM001 - VM/SP" then
        AmtValue = trim(Sess.Screen.GetString( 5, 10, 50))
          wb.WorkSheets("Sheet1").Cells(11, "H").Value = AmtValue
            End If
    AmtCheck = trim(Sess.Screen.GetString( 6, 10, 22))
      If AmtCheck = "A VM001 - VM/SP" then
        AmtValue = trim(Sess.Screen.GetString( 6, 10, 50))
          wb.WorkSheets("Sheet1").Cells(11, "H").Value = AmtValue
            End If
    AmtCheck = trim(Sess.Screen.GetString( 7, 10, 22))
      If AmtCheck = "A VM001 - VM/SP" then
        AmtValue = trim(Sess.Screen.GetString( 7, 10, 50))
          wb.WorkSheets("Sheet1").Cells(11, "H").Value = AmtValue
            End If      
      
  wb.SaveAs filename:= "c:\" & Format(Date, "mm.dd.yy") & "_excel ccmbalance.xlsx"
  
  xl.Quit
  
End Sub

 

[vzachin]

try this

for x = 2 to 7 'where x is the first row & 7 is the last row
AmtCheck = trim(Sess.Screen.GetString( x, 10, 22))
      If AmtCheck = "A VM001 - VM/SP" then
        AmtValue = trim(Sess.Screen.GetString( x, 10, 50))
          wb.WorkSheets("Sheet1").Cells(11, "H").Value = AmtValue
            End If
next x

 

[SkipVought]

EVERY ONE OF THESE is written to Row 11 Colum H??? Only the LAST scrape remains.

for x = 2 to 7 'where 2 is the first row & 7 is the last row
   Amt = trim(Sess.Screen.GetString( x, 10, 50))
   If trim(Left(Amt,22)) = "A VM001 - VM/SP" then
      wb.WorkSheets("Sheet1").Cells(11[red][b] + x[/b][/red], "H").Value = Amt
   End If
next x

or something like that.



Skip,
[sub]
Just traded in my old subtlety...
for a NUANCE![/sub]

 

[brumo]

Your code did the trick, so thanks vzachin. My macro looks much better now.

 

[brumo]

'Cause I wanted to copy/paste the value from just the row containing "A VM001 - VM/SP", vzachin's code worked fine. Thanks Skip, I'll use it for something.

 

[SkipVought]

"...the value from just the row containing "A VM001 - VM/SP"...

Then you ought to have an Exit For to get out as soon as you've found it...

for x = 2 to 7 'where x is the first row & 7 is the last row
AmtCheck = trim(Sess.Screen.GetString( x, 10, 22))
      If AmtCheck = "A VM001 - VM/SP" then
        AmtValue = trim(Sess.Screen.GetString( x, 10, 50))
          wb.WorkSheets("Sheet1").Cells(11, "H").Value = AmtValue[b]
          Exit For[/b]
            End If
next x

Skip,
[sub]
Just traded in my old subtlety...
for a NUANCE![/sub]

 

[vzachin]

skip's correct.
add the EXIT FOR to speed up the code

 

[Skie]

If you want to speed up the code grab the area as a string, then parse the string as rows. If you time it out you'll find the time it takes for the extra Extra calls is pretty significant. To give you an idea of the overhead of calls to Extra.

VBScript

Set oDictionary = CreateObject("Scripting.Dictionary")
Set oExtra = CreateObject("Extra.System")
iTimer = Timer
For i = 1 to 24
  oDictionary.Add i, oExtra.ActiveSession.Screen.GetString(i, 1, 80)
Next
iTimer = Timer - iTimer

iTimer2 = Timer
myArea = oExtra.ActiveSession.Screen.Area(1,1,24,80,,2).Value
For i = 1 to 24
  myString = Mid(myArea, ((i * 80) - 79), 80)
  oDictionary.Add i + 24, myString
Next
iTimer2 = Timer - iTimer2
MsgBox "GetString: " & iTimer & vbCrlf & "Area: " & iTimer2 & vbCrLf & iTimer/iTimer2 "Times Faster"

[tt]GetString: 0.4882813 Seconds
Area: 0.01953125 Seconds
25 Times Faster[/tt]

 

[SkipVought]

I wholehreartedly agree with skie. When I do screen scrapes, I grab the entire screen area, (1,1,24,80). I have defined the screen fields in a spec sheet (in excel) and I have functions that use the screen spec (scrnName, fldName, FromRow, ThruRow, Col, Len, Type). New screen is just a new screen spec in my spec sheet and a new output sheet, with all field headings for the dump. Usually takes 15-20 minutes for a new inquiry screen.

Skip,
[sub]
Just traded in my old subtlety...
for a NUANCE![/sub]