Reply to thread

Message: [QUOTE="Joel, post: 6349458"] 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 [/QUOTE]

Verification