Looping Macro to scrap multiple pages in Mainframe

T

TXDalessandros

I think I need to put in my code somewhere a way to count my rows....
I am scraping from a mainframe rows of data. All complete pages have 18
rows the last page may have less than that. to get to the next page the
macro simulates hitting F1. However the macro is overwritting the data
gathered from the first 18 lines.

Can someone advise what code I need to add so that the macro gathers the
first page then moves down in excel to continue gathering more pages until
there are no more?
Dim Sessions As Object
Dim System As Object
Dim SystemSess As Object
Dim SessName As String
Dim intSettleTime As Integer ' FOCUS settle time,
short wait after transaction
Dim intRC As Integer ' Return code
Dim strSes1 As String ' Extra session 1
Dim strSes2 As String ' Extra session 2
Dim strSes3 As String ' Extra session 3
Dim strSes4 As String ' Extra session 4
Dim strSes5 As String ' Extra session 5
Dim strSes6 As String ' Extra session 6
Dim strSes7 As String ' Extra session 7
Dim strSes8 As String ' Extra session 8
Dim strSesNbr As String
Dim strText1 As String ' Return value from
Msg box selection
Dim intSeso As Integer
Dim strInitials As String ' Entry operator
initials
Dim strRqstrName As String ' Requestor's name
Dim strRqstrPhn As String ' Requestor's phone
number
Dim intDataRow As Integer ' Spreadsheet row
number
Dim Masterbook As Workbook ' Read in customer
data from this spreadsheet file
Dim MasterSheet As Worksheet ' Worksheet
containing customer data
Dim Databook As Workbook ' Write result data
to this spreadsheet file
Dim Datasheet As Worksheet ' Worksheet
containing result data
Dim blnHasError As Boolean ' Error flag
Dim objSess0 As Object
Dim strAQIKerror As String
Dim ObjSource As Object
Dim intResultRow As Integer
Dim i As Integer
Dim iSameRow As Integer
iSameRow = 0

Dim objSessOpen As Object
Dim intI As Integer, intErr As Integer, intSess2 As Integer
i = 1
intErr = 0
'***Provides a reference for all of the settings***
'***Housekeeping***

'Application.ScreenUpdating = False ' turn screen
updating off to speed up macro code
Application.DisplayAlerts = False ' turn off
prompts/alert msgs while macro is running
Reset ' close all active
I/O files
blnHasError = False ' initialize error
flag

'***Set statements - assigns an object reference to a variable***
Set System = CreateObject("EXTRA.System") 'Gets the
system object
Set SystemSess = CreateObject("EXTRA.Sessions") 'Gets the
system object

'***Check if mainframe session is available, pick one if multiple are open***
'***If EXTRA does not exist then stop the macro by existing this program***
If IsEmpty(System) Then
MsgBox "Could not create the EXTRA System object. Stopping macro
playback."
Exit Sub
End If

'***Select EXTRA SESSIONS***
'***MsgBox to select EXTRA session if more than 1 are open**
strText1 = "There are " & SystemSess.Count & " Extra Sessions Available.
Enter the number of the Session to use." & Chr$(13)

'***Test to see how many, if any, EXTRA sessions are open***
ReDim strSes(0 To 8) As Variant

'***How many sessions are open?***
Dim intSysSess As Integer
intSysSess = SystemSess.Count

'***No Session are open***
If intSysSess = 0 Then
intRC = MsgBox("There are no Extra sessions open. Please start at
least one Session.", vbCritical, "")
End If

'***Determine all open sessions to choose from***
If intSysSess >= 1 Then
Do While i <= intSysSess
strSes(i) = System.Sessions.Item(i).Name
i = i + 1
Loop

If intSysSess = 1 Then
strSesNbr = InputBox(strText1 & "1 " & strSes(1), "", "1")
ElseIf intSysSess = 2 Then
strSesNbr = InputBox(strText1 & "1 " & strSes(1) & Chr$(13)
& "2 " & strSes(2), "", "1")
ElseIf intSysSess = 3 Then
strSesNbr = InputBox(strText1 & "1 " & strSes(1) & Chr$(13)
& "2 " & strSes(2) & Chr$(13) & "3 " & strSes(3), "", "1")
ElseIf intSysSess = 4 Then
strSesNbr = InputBox(strText1 & "1 " & strSes(1) & Chr$(13)
& "2 " & strSes(2) & Chr$(13) & "3 " & strSes(3) & Chr$(13) & "4 " &
strSes(4), "", "1")
ElseIf intSysSess = 5 Then
strSesNbr = InputBox(strText1 & "1 " & strSes(1) & Chr$(13)
& "2 " & strSes(2) & Chr$(13) & "3 " & strSes(3) & Chr$(13) & "4 " &
strSes(4) & Chr$(13) & "5 " & strSes(5), "", "1")
ElseIf intSysSess = 6 Then
strSesNbr = InputBox(strText1 & "1 " & strSes1 & Chr$(13) &
"2 " & strSes2 & Chr$(13) & "3 " & strSes3 & Chr$(13) & "4 " & strSes4 &
Chr$(13) & "5 " & strSes5 & Chr$(13) & "6 " & strSes6, "", "1")
ElseIf intSysSess = 7 Then
strSesNbr = InputBox(strText1 & "1 " & strSes1 & Chr$(13) &
"2 " & strSes2 & Chr$(13) & "3 " & strSes3 & Chr$(13) & "4 " & strSes4 &
Chr$(13) & "5 " & strSes5 & Chr$(13) & "6 " & strSes6 & Chr$(13) & "7 " &
strSes7, "", "1")
ElseIf intSysSess = 8 Then
strSesNbr = InputBox(strText1 & "1 " & strSes1 & Chr$(13) &
"2 " & strSes2 & Chr$(13) & "3 " & strSes3 & Chr$(13) & "4 " & strSes4 &
Chr$(13) & "5 " & strSes5 & Chr$(13) & "6 " & strSes6 & Chr$(13) & "7 " &
strSes7 & Chr$(13) & "8 " & strSes8, "", "1")
End If
'***If an invalid session is chosen***
If Val(strSesNbr) > SystemSess.Count Then
intRC = MsgBox("An invalid session number was selected. Please
retry.", vbCritical, "")
End If

End If

'***Exit program if no session is chosen***
If strSesNbr = "" Then End

'***If selected session is not connected***
If System.Sessions.Item(intSeso).Connected = False Then
intRC = MsgBox("The selected session is not connected to the network.
Please reselect.", vbCritical, "")
End If



'***Converts session number from string to an integer value***
intSeso = Val(strSesNbr)
intSettleTime = 200 'milliseconds '# set the integer value of the variable
SettleTime #
Set objSess0 = System.Sessions.Item(intSeso)
objSess0.Screen.waitHostQuiet (intSettleTime)
System.Sessions.Item(intSeso).Visible = True

'********************************************************************************
'***Begin RACE Scrap Process***

Set Masterbook = Workbooks(ActiveWorkbook.Name)
Worksheets("report").Activate

Range("C3").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Clear
ActiveWindow.SmallScroll Down:=-12
Range("C3").Select

'***Starts on the RACE SCREEN***

Dim strType As String
Dim strEmpty As String

strEmpty = " "

With objSess0.Screen
'***The user need to get to RACE Screen in FOCUS*****

strType = .getString(1, 2, 4)
If (StrComp(Trim(strType), "RACE", vbTextCompare) <> 0) Then
MsgBox ("Please navigate to RACE and Replay the macro")
Exit Sub
Else




'***Grab all data on Race que page 1 then continue by hitting PF1 to
go to next page until no more pages*

'............RACE DATA FOUND RETRIEVING
.......................
ActiveCell.Offset(iSameRow, 0) = .getString(5, 8, 3)
'CNS ORG Row 1
ActiveCell.Offset(iSameRow, 1) = .getString(5, 12, 3)
'AB ORG Row 1
ActiveCell.Offset(iSameRow, 2) = .getString(5, 16, 11)
'AIRBILL Row 1
ActiveCell.Offset(iSameRow, 3) = .getString(5, 28, 11)
'ITEM NBR Row 1
ActiveCell.Offset(iSameRow, 4) = .getString(5, 40, 6)
'DATE Row 1
ActiveCell.Offset(iSameRow, 5) = .getString(5, 47, 1)
'Type Row 1
ActiveCell.Offset(iSameRow, 6) = .getString(5, 49, 32)
'RROR Row 1
iSameRow = iSameRow + 1
ActiveCell.Offset(iSameRow, 0) = .getString(6, 8, 3)
'CNS ORG Row 2
ActiveCell.Offset(iSameRow, 1) = .getString(6, 12, 3)
'AB ORG Row 2
ActiveCell.Offset(iSameRow, 2) = .getString(6, 16, 11)
'AIRBILL Row 2
ActiveCell.Offset(iSameRow, 3) = .getString(6, 28, 11)
'ITEM NBR Row 2
ActiveCell.Offset(iSameRow, 4) = .getString(6, 40, 6)
'DATE Row 2
ActiveCell.Offset(iSameRow, 5) = .getString(6, 47, 1)
'Type Row 2
ActiveCell.Offset(iSameRow, 6) = .getString(6, 49, 32)
'ERROR Row 2
iSameRow = iSameRow + 1
ActiveCell.Offset(iSameRow, 0) = .getString(7, 8, 3)
'CNS ORG Row 3
ActiveCell.Offset(iSameRow, 1) = .getString(7, 12, 3)
'AB ORG Row 3
ActiveCell.Offset(iSameRow, 2) = .getString(7, 16, 11)
'AIRBILL Row 3
ActiveCell.Offset(iSameRow, 3) = .getString(7, 28, 11)
'ITEM NBR Row 3
ActiveCell.Offset(iSameRow, 4) = .getString(7, 40, 6)
'DATE Row 3
ActiveCell.Offset(iSameRow, 5) = .getString(7, 47, 1)
'Type Row 3
ActiveCell.Offset(iSameRow, 6) = .getString(7, 49, 32)
'ERROR Row 3
iSameRow = iSameRow + 1
ActiveCell.Offset(iSameRow, 0) = .getString(8, 8, 3)
'CNS ORG Row 4
ActiveCell.Offset(iSameRow, 1) = .getString(8, 12, 3)
'AB ORG Row 4
ActiveCell.Offset(iSameRow, 2) = .getString(8, 16, 11)
'AIRBILL Row 4
ActiveCell.Offset(iSameRow, 3) = .getString(8, 28, 11)
'ITEM NBR Row 4
ActiveCell.Offset(iSameRow, 4) = .getString(8, 40, 6)
'DATE Row 4
ActiveCell.Offset(iSameRow, 5) = .getString(8, 47, 1)
'Type Row 4
ActiveCell.Offset(iSameRow, 6) = .getString(8, 49, 32)
'ERROR Row 4
iSameRow = iSameRow + 1
ActiveCell.Offset(iSameRow, 0) = .getString(9, 8, 3)
'CNS ORG Row 5
ActiveCell.Offset(iSameRow, 1) = .getString(9, 12, 3)
'AB ORG Row 5
ActiveCell.Offset(iSameRow, 2) = .getString(9, 16, 11)
'AIRBILL Row 5
ActiveCell.Offset(iSameRow, 3) = .getString(9, 28, 11)
'ITEM NBR Row 5
ActiveCell.Offset(iSameRow, 4) = .getString(9, 40, 6)
'DATE Row 5
ActiveCell.Offset(iSameRow, 5) = .getString(9, 47, 1)
'Type Row 5
ActiveCell.Offset(iSameRow, 6) = .getString(9, 49, 32)
'ERROR Row 5
iSameRow = iSameRow + 1
ActiveCell.Offset(iSameRow, 0) = .getString(10, 8, 3)
'CNS ORG Row 6
ActiveCell.Offset(iSameRow, 1) = .getString(10, 12, 3)
'AB ORG Row 6
ActiveCell.Offset(iSameRow, 2) = .getString(10, 16, 11)
'AIRBILL Row 6
ActiveCell.Offset(iSameRow, 3) = .getString(10, 28, 11)
'ITEM NBR Row 6
ActiveCell.Offset(iSameRow, 4) = .getString(10, 40, 6)
'DATE Row 6
ActiveCell.Offset(iSameRow, 5) = .getString(10, 47, 1)
'Type Row 6
ActiveCell.Offset(iSameRow, 6) = .getString(10, 49, 32)
'ERROR Row 6
iSameRow = iSameRow + 1
ActiveCell.Offset(iSameRow, 0) = .getString(11, 8, 3)
'CNS ORG Row 7
ActiveCell.Offset(iSameRow, 1) = .getString(11, 12, 3)
'AB ORG Row 7
ActiveCell.Offset(iSameRow, 2) = .getString(11, 16, 11)
'AIRBILL Row 7
ActiveCell.Offset(iSameRow, 3) = .getString(11, 28, 11)
'ITEM NBR Row 7
ActiveCell.Offset(iSameRow, 4) = .getString(11, 40, 6)
'DATE Row 7
ActiveCell.Offset(iSameRow, 5) = .getString(11, 47, 1)
'Type Row 7
ActiveCell.Offset(iSameRow, 6) = .getString(11, 49, 32)
'ERROR Row 7
iSameRow = iSameRow + 1
ActiveCell.Offset(iSameRow, 0) = .getString(12, 8, 3)
'CNS ORG Row 8
ActiveCell.Offset(iSameRow, 1) = .getString(12, 12, 3)
'AB ORG Row 8
ActiveCell.Offset(iSameRow, 2) = .getString(12, 16, 11)
'AIRBILL Row 8
ActiveCell.Offset(iSameRow, 3) = .getString(12, 28, 11)
'ITEM NBR Row 8
ActiveCell.Offset(iSameRow, 4) = .getString(12, 40, 6)
'DATE Row 8
ActiveCell.Offset(iSameRow, 5) = .getString(12, 47, 1)
'Type Row 8
ActiveCell.Offset(iSameRow, 6) = .getString(12, 49, 32)
'ERROR Row 8
iSameRow = iSameRow + 1
ActiveCell.Offset(iSameRow, 0) = .getString(13, 8, 3)
'CNS ORG Row 9
ActiveCell.Offset(iSameRow, 1) = .getString(13, 12, 3)
'AB ORG Row 9
ActiveCell.Offset(iSameRow, 2) = .getString(13, 16, 11)
'AIRBILL Row 9
ActiveCell.Offset(iSameRow, 3) = .getString(13, 28, 11)
'ITEM NBR Row 9
ActiveCell.Offset(iSameRow, 4) = .getString(13, 40, 6)
'DATE Row 9
ActiveCell.Offset(iSameRow, 5) = .getString(13, 47, 1)
'Type Row 9
ActiveCell.Offset(iSameRow, 6) = .getString(13, 49, 32)
'ERROR Row 9
iSameRow = iSameRow + 1
ActiveCell.Offset(iSameRow, 0) = .getString(14, 8, 3)
'CNS ORG Row 10
ActiveCell.Offset(iSameRow, 1) = .getString(14, 12, 3)
'AB ORG Row 10
ActiveCell.Offset(iSameRow, 2) = .getString(14, 16, 11)
'AIRBILL Row 10
ActiveCell.Offset(iSameRow, 3) = .getString(14, 28, 11)
'ITEM NBR Row 10
ActiveCell.Offset(iSameRow, 4) = .getString(14, 40, 6)
'DATE Row 10
ActiveCell.Offset(iSameRow, 5) = .getString(14, 47, 1)
'Type Row 10
ActiveCell.Offset(iSameRow, 6) = .getString(14, 49, 32)
'ERROR Row 10
iSameRow = iSameRow + 1
ActiveCell.Offset(iSameRow, 0) = .getString(15, 8, 3)
'CNS ORG Row 11
ActiveCell.Offset(iSameRow, 1) = .getString(15, 12, 3)
'AB ORG Row 11
ActiveCell.Offset(iSameRow, 2) = .getString(15, 16, 11)
'AIRBILL Row 11
ActiveCell.Offset(iSameRow, 3) = .getString(15, 28, 11)
'ITEM NBR Row 11
ActiveCell.Offset(iSameRow, 4) = .getString(15, 40, 6)
'DATE Row 11
ActiveCell.Offset(iSameRow, 5) = .getString(15, 47, 1)
'Type Row 11
ActiveCell.Offset(iSameRow, 6) = .getString(15, 49, 32)
'ERROR Row 11
iSameRow = iSameRow + 1
ActiveCell.Offset(iSameRow, 0) = .getString(16, 8, 3)
'CNS ORG Row 12
ActiveCell.Offset(iSameRow, 1) = .getString(16, 12, 3)
'AB ORG Row 12
ActiveCell.Offset(iSameRow, 2) = .getString(16, 16, 11)
'AIRBILL Row 12
ActiveCell.Offset(iSameRow, 3) = .getString(16, 28, 11)
'ITEM NBR Row 12
ActiveCell.Offset(iSameRow, 4) = .getString(16, 40, 6)
'DATE Row 12
ActiveCell.Offset(iSameRow, 5) = .getString(16, 47, 1)
'Type Row 12
ActiveCell.Offset(iSameRow, 6) = .getString(16, 49, 32)
'ERROR Row 12
iSameRow = iSameRow + 1
ActiveCell.Offset(iSameRow, 0) = .getString(17, 8, 3)
'CNS ORG Row 13
ActiveCell.Offset(iSameRow, 1) = .getString(17, 12, 3)
'AB ORG Row 13
ActiveCell.Offset(iSameRow, 2) = .getString(17, 16, 11)
'AIRBILL Row 13
ActiveCell.Offset(iSameRow, 3) = .getString(17, 28, 11)
'ITEM NBR Row 13
ActiveCell.Offset(iSameRow, 4) = .getString(17, 40, 6)
'DATE Row 13
ActiveCell.Offset(iSameRow, 5) = .getString(5, 47, 1)
'Type Row 13
ActiveCell.Offset(iSameRow, 6) = .getString(17, 49, 32)
'ERROR Row 13
iSameRow = iSameRow + 1
ActiveCell.Offset(iSameRow, 0) = .getString(18, 8, 3)
'CNS ORG Row 14
ActiveCell.Offset(iSameRow, 1) = .getString(18, 12, 3)
'AB ORG Row 14
ActiveCell.Offset(iSameRow, 2) = .getString(18, 16, 11)
'AIRBILL Row 14
ActiveCell.Offset(iSameRow, 3) = .getString(18, 28, 11)
'ITEM NBR Row 14
ActiveCell.Offset(iSameRow, 4) = .getString(18, 40, 6)
'DATE Row 14
ActiveCell.Offset(iSameRow, 5) = .getString(18, 47, 1)
'Type Row 14
ActiveCell.Offset(iSameRow, 6) = .getString(18, 49, 32)
'ERROR Row 14
iSameRow = iSameRow + 1
ActiveCell.Offset(iSameRow, 0) = .getString(19, 8, 3)
'CNS ORG Row 15
ActiveCell.Offset(iSameRow, 1) = .getString(19, 12, 3)
'AB ORG Row 15
ActiveCell.Offset(iSameRow, 2) = .getString(19, 16, 11)
'AIRBILL Row 15
ActiveCell.Offset(iSameRow, 3) = .getString(19, 28, 11)
'ITEM NBR Row 15
ActiveCell.Offset(iSameRow, 4) = .getString(19, 40, 6)
'DATE Row 15
ActiveCell.Offset(iSameRow, 5) = .getString(19, 47, 1)
'Type Row 15
ActiveCell.Offset(iSameRow, 6) = .getString(19, 49, 32)
'ERROR Row 15
iSameRow = iSameRow + 1
ActiveCell.Offset(iSameRow, 0) = .getString(20, 8, 3)
'CNS ORG Row 16
ActiveCell.Offset(iSameRow, 1) = .getString(20, 12, 3)
'AB ORG Row 16
ActiveCell.Offset(iSameRow, 2) = .getString(20, 16, 11)
'AIRBILL Row 16
ActiveCell.Offset(iSameRow, 3) = .getString(20, 28, 11)
'ITEM NBR Row 16
ActiveCell.Offset(iSameRow, 4) = .getString(20, 40, 6)
'DATE Row 16
ActiveCell.Offset(iSameRow, 5) = .getString(20, 47, 1)
'Type Row 16
ActiveCell.Offset(iSameRow, 6) = .getString(20, 49, 32)
'ERROR Row 16
iSameRow = iSameRow + 1
ActiveCell.Offset(iSameRow, 0) = .getString(21, 8, 3)
'CNS ORG Row 17
ActiveCell.Offset(iSameRow, 1) = .getString(21, 12, 3)
'AB ORG Row 17
ActiveCell.Offset(iSameRow, 2) = .getString(21, 16, 11)
'AIRBILL Row 17
ActiveCell.Offset(iSameRow, 3) = .getString(21, 28, 11)
'ITEM NBR Row 17
ActiveCell.Offset(iSameRow, 4) = .getString(21, 40, 6)
'DATE Row 17
ActiveCell.Offset(iSameRow, 5) = .getString(21, 47, 1)
'Type Row 17
ActiveCell.Offset(iSameRow, 6) = .getString(21, 49, 32)
'ERROR Row 17
iSameRow = iSameRow + 1
ActiveCell.Offset(iSameRow, 0) = .getString(22, 8, 3)
'CNS ORG Row 18
ActiveCell.Offset(iSameRow, 1) = .getString(22, 12, 3)
'AB ORG Row 18
ActiveCell.Offset(iSameRow, 2) = .getString(22, 16, 11)
'AIRBILL Row 18
ActiveCell.Offset(iSameRow, 3) = .getString(22, 28, 11)
'ITEM NBR Row 18
ActiveCell.Offset(iSameRow, 4) = .getString(22, 40, 6)
'DATE Row 18
ActiveCell.Offset(iSameRow, 5) = .getString(22, 47, 1)
'Type Row 18
ActiveCell.Offset(iSameRow, 6) = .getString(22, 49, 32)
'Error Row 18

If .getString(24, 2, 26) = "E255 THIS IS THE LAST
PAGE" Then
GoTo EndOfFile

Else
.SendKeys "<Pf1>"
iSameRow = iSameRow + 1
Do While objSess0.Screen.OIA.XStatus <> 0
DoEvents
Loop

End If

End If

EndOfFile:
MsgBox "Macro Complete"

End With

End Sub
 
J

Joel

I think I solved all you problems and simplified the code tremedously by
adding some loops instead of linear coding.

Sub GetSessionData()
Dim Sessions As Object
Dim System As Object
Dim SystemSess As Object
Dim SessName As String
Dim intSettleTime As Integer ' FOCUS settle time,short wait after
transaction
Dim intRC As Integer ' Return code
Dim strSes1 As String ' Extra session 1
Dim strSes2 As String ' Extra session 2
Dim strSes3 As String ' Extra session 3
Dim strSes4 As String ' Extra session 4
Dim strSes5 As String ' Extra session 5
Dim strSes6 As String ' Extra session 6
Dim strSes7 As String ' Extra session 7
Dim strSes8 As String ' Extra session 8
Dim strSesNbr As String
Dim strText1 As String ' Return value from Msg box selection
Dim intSeso As Integer
Dim strInitials As String ' Entry operator initials
Dim strRqstrName As String ' Requestor's name
Dim strRqstrPhn As String ' Requestor's phone Number
Dim intDataRow As Integer ' Spreadsheet row Number
Dim Masterbook As Workbook ' Read in customer data from this
spreadsheet file
Dim MasterSheet As Worksheet ' Worksheet containing customer data
Dim Databook As Workbook ' Write result data to this spreadsheet file
Dim Datasheet As Worksheet ' Worksheet containing result data
Dim blnHasError As Boolean ' Error flag
Dim objSess0 As Object
Dim strAQIKerror As String
Dim ObjSource As Object
Dim intResultRow As Integer
Dim i As Integer
Dim iSameRow As Integer
iSameRow = 0

Dim objSessOpen As Object
Dim intI As Integer, intErr As Integer, intSess2 As Integer
i = 1
intErr = 0
'***Provides a reference for all of the settings***
'***Housekeeping***

'Application.ScreenUpdating = False ' turn screen updating off to speed up
macro code
Application.DisplayAlerts = False ' turn off prompts/alert msgs while
macro is running
Reset ' close all active I/O files
blnHasError = False ' initialize error flag

'***Set statements - assigns an object reference to a variable***
Set System = CreateObject("EXTRA.System") 'Gets the System Object
Set SystemSess = CreateObject("EXTRA.Sessions") 'Gets the System Object

'***Check if mainframe session is available, pick one if multiple are open***
'***If EXTRA does not exist then stop the macro by existing this program***
If IsEmpty(System) Then
MsgBox "Could not create the EXTRA System object." & _
" Stopping macro playback."
Exit Sub
End If

'***Select EXTRA SESSIONS***
'***MsgBox to select EXTRA session if more than 1 are open**
strText1 = "There are " & SystemSess.Count & _
" Extra Sessions Available." & _
"Enter the number of the Session to use." & Chr$(13)

'***Test to see how many, if any, EXTRA sessions are open***
ReDim strSes(0 To 8) As Variant

'***How many sessions are open?***
Dim intSysSess As Integer
intSysSess = SystemSess.Count

'***No Session are open***
If intSysSess = 0 Then
intRC = MsgBox("There are no Extra sessions open." & _
" Please start at least one Session.", vbCritical, "")
End If

'***Determine all open sessions to choose from***
If intSysSess >= 1 Then
Do While i <= intSysSess
strSes(i) = System.Sessions.Item(i).Name
i = i + 1
Loop

InputMess = strText1
For Count = 1 To intSysSess
If Count = 1 Then
InputMess = InputMess & Count & " " & strSes(Count)
Else
InputMess = InputMess & Chr$(13) & Count & " " & strSes(Count)
End If
Next Count
strSesNbr = InputBox(InputMess, "", "1")

'***Exit program if no session is chosen***
If strSesNbr = "" Then End
End If
'***If selected session is not connected***
If System.Sessions.Item(intSeso).Connected = False Then
intRC = MsgBox("The selected session is not connected" & _
"to the network. Please reselect.", vbCritical, "")
End If



'***Converts session number from string to an integer value***
intSeso = Val(strSesNbr)
intSettleTime = 200 'milliseconds '# set the integer value of the variable
SettleTime #
Set objSess0 = System.Sessions.Item(intSeso)
objSess0.Screen.waitHostQuiet (intSettleTime)
System.Sessions.Item(intSeso).Visible = True

'********************************************************************************
'***Begin RACE Scrap Process***

Set Masterbook = Workbooks(ActiveWorkbook.Name)
Worksheets("report").Activate

Set LastCol = Range("C3").End(xlToRight)
Set LastCell = LastCol.End(xlDown)
Range(Range("C3"), LastCell).Clear

ActiveWindow.SmallScroll Down:=-12

'***Starts on the RACE SCREEN***

Dim strType As String
Dim strEmpty As String

strEmpty = " "

With objSess0.Screen
RowCount = 3
Done = False
Do While Done = False
'***The user need to get to RACE Screen in FOCUS*****

strType = .getString(1, 2, 4)
If (StrComp(Trim(strType), "RACE", vbTextCompare) <> 0) Then
MsgBox ("Please navigate to RACE and Replay the macro")
Exit Sub
Else

'***Grab all data on Race que page 1 then continue by hitting PF1 to
'go to next page until no more pages*

'............RACE DATA FOUND RETRIEVING ......................
For iSameRow = 0 To 17

Range("C" & RowCount).Offset(iSameRow, 0) = _
.getString(iSameRow + 5, 8, 3) 'CNS ORG Row 1
Range("C" & RowCount).Offset(iSameRow, 1) = _
.getString(iSameRow + 5, 12, 3) 'AB ORG Row 1
Range("C" & RowCount).Offset(iSameRow, 2) = _
.getString(iSameRow + 5, 16, 11) 'AIRBILL Row 1
Range("C" & RowCount).Offset(iSameRow, 3) = _
.getString(iSameRow + 5, 28, 11) 'ITEM NBR Row 1
Range("C" & RowCount).Offset(iSameRow, 4) = _
.getString(iSameRow + 5, 40, 6) 'DATE Row 1
Range("C" & RowCount).Offset(iSameRow, 5) = _
.getString(iSameRow + 5, 47, 1) 'Type Row 1
Range("C" & RowCount).Offset(iSameRow, 6) = _
.getString(iSameRow + 5, 49, 32) 'RROR Row 1
Next iSameRow

If .getString(24, 2, 26) = "E255 THIS IS THE LAST PAGE" Then
MsgBox "Macro Complete"
Done = True
Else
.SendKeys "<Pf1>"
Do While objSess0.Screen.OIA.XStatus <> 0
DoEvents
Loop

End If

End If
RowCount = RowCount + 18
Loop
End With

End Sub
 
J

Joel

I reposted the code to remove a few errors cause by long lines

Sub GetSessionData()
Dim Sessions As Object
Dim System As Object
Dim SystemSess As Object
Dim SessName As String
Dim intSettleTime As Integer ' FOCUS settle time,
' short wait after transaction
Dim intRC As Integer ' Return code
Dim strSes1 As String ' Extra session 1
Dim strSes2 As String ' Extra session 2
Dim strSes3 As String ' Extra session 3
Dim strSes4 As String ' Extra session 4
Dim strSes5 As String ' Extra session 5
Dim strSes6 As String ' Extra session 6
Dim strSes7 As String ' Extra session 7
Dim strSes8 As String ' Extra session 8
Dim strSesNbr As String
Dim strText1 As String ' Return value from Msg box selection
Dim intSeso As Integer
Dim strInitials As String ' Entry operator initials
Dim strRqstrName As String ' Requestor's name
Dim strRqstrPhn As String ' Requestor's phone Number
Dim intDataRow As Integer ' Spreadsheet row Number
Dim Masterbook As Workbook ' Read in customer data from this
' spreadsheet file
Dim MasterSheet As Worksheet ' Worksheet containing customer data
Dim Databook As Workbook ' Write result data to this spreadsheet file
Dim Datasheet As Worksheet ' Worksheet containing result data
Dim blnHasError As Boolean ' Error flag
Dim objSess0 As Object
Dim strAQIKerror As String
Dim ObjSource As Object
Dim intResultRow As Integer
Dim i As Integer
Dim iSameRow As Integer
iSameRow = 0

Dim objSessOpen As Object
Dim intI As Integer, intErr As Integer, intSess2 As Integer
i = 1
intErr = 0
'***Provides a reference for all of the settings***
'***Housekeeping***

'Application.ScreenUpdating = False ' turn screen updating off to speed up
' macro code
Application.DisplayAlerts = False ' turn off prompts/alert msgs while
' macro is running
Reset ' close all active I/O files
blnHasError = False ' initialize error flag

'***Set statements - assigns an object reference to a variable***
Set System = CreateObject("EXTRA.System") 'Gets the System Object
Set SystemSess = CreateObject("EXTRA.Sessions") 'Gets the System Object

'***Check if mainframe session is available, pick one if multiple are open***
'***If EXTRA does not exist then stop the macro by existing this program***
If IsEmpty(System) Then
MsgBox "Could not create the EXTRA System object." & _
" Stopping macro playback."
Exit Sub
End If

'***Select EXTRA SESSIONS***
'***MsgBox to select EXTRA session if more than 1 are open**
strText1 = "There are " & SystemSess.Count & _
" Extra Sessions Available." & _
"Enter the number of the Session to use." & Chr$(13)

'***Test to see how many, if any, EXTRA sessions are open***
ReDim strSes(0 To 8) As Variant

'***How many sessions are open?***
Dim intSysSess As Integer
intSysSess = SystemSess.Count

'***No Session are open***
If intSysSess = 0 Then
intRC = MsgBox("There are no Extra sessions open." & _
" Please start at least one Session.", vbCritical, "")
End If

'***Determine all open sessions to choose from***
If intSysSess >= 1 Then
Do While i <= intSysSess
strSes(i) = System.Sessions.Item(i).Name
i = i + 1
Loop

InputMess = strText1
For Count = 1 To intSysSess
If Count = 1 Then
InputMess = InputMess & Count & " " & strSes(Count)
Else
InputMess = InputMess & Chr$(13) & Count & " " & strSes(Count)
End If
Next Count
strSesNbr = InputBox(InputMess, "", "1")

'***Exit program if no session is chosen***
If strSesNbr = "" Then End
End If
'***If selected session is not connected***
If System.Sessions.Item(intSeso).Connected = False Then
intRC = MsgBox("The selected session is not connected" & _
"to the network. Please reselect.", vbCritical, "")
End If



'***Converts session number from string to an integer value***
intSeso = Val(strSesNbr)
intSettleTime = 200 'milliseconds '# set the integer value of the variable
'SettleTime #
Set objSess0 = System.Sessions.Item(intSeso)
objSess0.Screen.waitHostQuiet (intSettleTime)
System.Sessions.Item(intSeso).Visible = True

'********************************************************************************
'***Begin RACE Scrap Process***

Set Masterbook = Workbooks(ActiveWorkbook.Name)
Worksheets("report").Activate

Set LastCol = Range("C3").End(xlToRight)
Set LastCell = LastCol.End(xlDown)
Range(Range("C3"), LastCell).Clear

ActiveWindow.SmallScroll Down:=-12

'***Starts on the RACE SCREEN***

Dim strType As String
Dim strEmpty As String

strEmpty = " "

With objSess0.Screen
RowCount = 3
Done = False
Do While Done = False
'***The user need to get to RACE Screen in FOCUS*****

strType = .getString(1, 2, 4)
If (StrComp(Trim(strType), "RACE", vbTextCompare) <> 0) Then
MsgBox ("Please navigate to RACE and Replay the macro")
Exit Sub
Else

'***Grab all data on Race que page 1 then continue by hitting PF1 to
'go to next page until no more pages*

'............RACE DATA FOUND RETRIEVING ......................
For iSameRow = 0 To 17

Range("C" & RowCount).Offset(iSameRow, 0) = _
.getString(iSameRow + 5, 8, 3) 'CNS ORG Row 1
Range("C" & RowCount).Offset(iSameRow, 1) = _
.getString(iSameRow + 5, 12, 3) 'AB ORG Row 1
Range("C" & RowCount).Offset(iSameRow, 2) = _
.getString(iSameRow + 5, 16, 11) 'AIRBILL Row 1
Range("C" & RowCount).Offset(iSameRow, 3) = _
.getString(iSameRow + 5, 28, 11) 'ITEM NBR Row 1
Range("C" & RowCount).Offset(iSameRow, 4) = _
.getString(iSameRow + 5, 40, 6) 'DATE Row 1
Range("C" & RowCount).Offset(iSameRow, 5) = _
.getString(iSameRow + 5, 47, 1) 'Type Row 1
Range("C" & RowCount).Offset(iSameRow, 6) = _
.getString(iSameRow + 5, 49, 32) 'RROR Row 1
Next iSameRow

If .getString(24, 2, 26) = "E255 THIS IS THE LAST PAGE" Then
MsgBox "Macro Complete"
Done = True
Else
.SendKeys "<Pf1>"
Do While objSess0.Screen.OIA.XStatus <> 0
DoEvents
Loop

End If

End If
RowCount = RowCount + 18
Loop
End With

End Sub
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

Transfer Data from UserForm to Worksheet 8
2007 code not working in 2003 5
Help needed: Getting all sheet setup data from one workbook toanother workbook 1
VBA array problem 5
Streamlining Code 3
PLEASE help ... 3
A workbook of macros which runs on external workbooks. 6
VBA for comparing data within a range for Excel 2003 2

Top