Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations SkipVought on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Sess0.Visible messing up my Excel when I close the workbook 1

Status
Not open for further replies.

kamfl610

Programmer
Apr 15, 2003
90
0
0
US
Hi all,

Don't know if this is happening with you.
I have a macro that runs in Excel that opens Extra 6.4 processes some screens, data, yada yada. When my macro finishes and I'm done with the process, I go to close the Workbook and Excel crashes. I've isolated it to Sess0.Visible statement. If it's commented out and I run the macro and finishes (obviously nothing happens in Extra), excel will close normally. What could I do to help with this problem? Anyone have any ideas? Here's the code of the macro i'm executing.
Code:
'-----------------------------------------------------------------------------------------------
Public Sub Allotments22()
'*********************************************************************************************
'*  This program screen scripts what's in the excel spreadsheets:                            *
'*  C:\Allotment Process\Allotment Entries into Extra.  For every type their is a sub to     *
'*  perform this since each allotment process has different fields and positions on the      *
'*  screen.  This one is for TR22's.  What it does is open the spreadsheet and then opens    *
'*  an instance of Extra and logs on with the lines 1-6.  And then scripts the cells to      *
'*  cells to the end.  If it encounters an error, it writes that error from the screen to    *
'*  excel spreadsheet and moves on to the next row.  This helps in not having them monitor   *
'*  this.  They will have to check to see what has processed.                                *
'*                                                                                           *
'*  Version History:                                                                         *
'*  1.0                 Kyong-A Minter          Original Program         07/26/2006          *
'*  1.1                 Kyong-A Minter          added logic to put          07/27/2006       *
'*                                              & check for complete & date in end columns   *
'*                                              so user's don't have to monkey with deleting *
'*                                              rows and stuff                               *
'*********************************************************************************************
    Dim introwcount As Integer
    Dim x As Integer
    Dim excelvalue As String
    Set System = New ExtraSystem

    ' Declare variables to contain the OLE objects
        Dim objExcel As Object
        Dim objWorkBook As Object
        Dim objChart As Object
   
        On Error Resume Next
   
' Attempt to get a reference to an open instance of Excel
        Set objExcel = GetObject(, "Excel.Application")
        If objExcel Is Nothing Then
           'If GetObject failed, open a new instance of Excel
            Set objExcel = CreateObject("Excel.Application")
            If objExcel Is Nothing Then
               MsgBox ("Could not open Excel.")
                Exit Sub
            End If
        End If
   
' Make Excel visible on the screen
        objExcel.Visible = True
   
' Create a new Workbook
        Set objWorkBook = objExcel.Workbooks.Open("C:\Allotment Process\Allotment Entries.xls")

        If objWorkBook Is Nothing Then
            MsgBox ("Could not open a new Excel workbook.")
            objExcel.Quit
            Exit Sub
        End If
    
    objWorkBook.Worksheets("TR22").Select
    'Exit Sub

    If (System Is Nothing) Then
    MsgBox "Could not create the EXTRA System object.  Stopping macro playback."
    Stop
    End If
    
Set Sessions = System.Sessions

    If (Sessions Is Nothing) Then
       MsgBox "Could not create the Sessions collection object.  Stopping macro playback."
             Stop
    End If

    Set Sess0 = System.Sessions.Open("FLAIR.EDP")
    If Not Sess0.Visible Then Sess0.Visible = True
    Dim move
    Dim move2
    Dim strL2L5 As String
    Dim fieldtest
    Dim strmessage
    Dim result
    Dim result2
    Dim x2
    
    Set MyScn = Sess0.Screen
    move = MyScn.WaitForCursorMove(3)
    Application.Wait (Now + TimeValue("0:00:01"))
    MyScn.PutString Range("A1").Offset(0, 1).Value
    MyScn.SendKeys ("<Enter>")
    move2 = MyScn.WaitForCursorMove(12)
    Application.Wait (Now + TimeValue("0:00:01"))
    MyScn.PutString Range("A1").Offset(1, 1).Value
    fieldtest = Value(Range("A1").Offset(2, 1).Value, 17, 36)
    MyScn.SendKeys ("<Enter>")
    move = MyScn.WaitForCursorMove(6)
    Application.Wait (Now + TimeValue("0:00:01"))
    MyScn.PutString "1"
    MyScn.SendKeys ("<Enter>")
    move2 = MyScn.WaitForCursorMove(-20)
    Application.Wait (Now + TimeValue("0:00:01"))
    MyScn.SendKeys ("<Enter>")
    move = MyScn.WaitForCursorMove(3)
    Application.Wait (Now + TimeValue("0:00:01"))
    MyScn.PutString Range("A1").Offset(3, 1).Value
    fieldtest = Value(Range("A1").Offset(4, 1).Value, 6, 18)
    fieldtest = Value(Range("A1").Offset(5, 1).Value, 6, 30)
    MyScn.SendKeys ("<Enter>")
    move2 = MyScn.WaitForCursorMove(16)
    Application.Wait (Now + TimeValue("0:00:01"))
    MyScn.PutString "22"
    fieldtest = Value("S", 22, 80)
    MyScn.SendKeys ("<Enter>")
    move = MyScn.WaitForCursorMove(-15)
    Application.Wait (Now + TimeValue("0:00:01"))
    For x = 9 To 250
        If Range("A1").Offset(x, 0) = "END" Then
            MyScn.SendKeys ("<Clear>")
            Application.Wait (Now + TimeValue("0:00:01"))
            MyScn.PutString ("cesf logoff")
            MyScn.SendKeys ("<Enter>")
            Sess0.Close
            Set MyScn = Nothing
            Set Sess0 = Nothing
            strmessage = MsgBox("TR22 Input Complete.  Please click okay and check your work.", vbOKOnly)
            Exit Sub
        End If
        '1.1 new change here:
        If Range("A1").Offset(x, 26).Value <> "Complete" Then
        '*****
            x2 = x + 1
            strL2L5 = L2L5(Range("A1").Offset(x, 1).Value)
            MyScn.PutString L2
            Sess0.Screen.MoveTo 7, 8
            MyScn.PutString L3
            Sess0.Screen.MoveTo 7, 11
            MyScn.PutString L4
            Sess0.Screen.MoveTo 7, 14
            MyScn.PutString L5
            fieldtest = Value(Range("A1").Offset(x, 2).Value, 7, 18)
            fieldtest = Value(Range("A1").Offset(x, 3).Value, 7, 21)
            fieldtest = Value(Range("A1").Offset(x, 4).Value, 7, 24)
            MyScn.SendKeys ("<Enter>")
            Application.Wait (Now + TimeValue("0:00:02"))
            result2 = Sess0.Screen.GetString(2, 2, 4)
            If result2 = "22S2" Then
                MyScn.PutString Range("A1").Offset(x, 5).Value
                fieldtest = Value(Range("A1").Offset(x, 6).Value, 6, 16)
                fieldtest = Value(Range("A1").Offset(x, 7).Value, 6, 47)
                fieldtest = Value(Range("A1").Offset(x, 8).Value, 6, 62)
                fieldtest = Value(Range("A1").Offset(x, 9).Value, 9, 7)
                fieldtest = Value(Range("A1").Offset(x, 10).Value, 9, 25)
                fieldtest = Value(Range("A1").Offset(x, 11).Value, 9, 33)
                fieldtest = Value(Range("A1").Offset(x, 12).Value, 9, 42)
                fieldtest = Value(Range("A1").Offset(x, 13).Value, 9, 62)
                fieldtest = Value(Range("A1").Offset(x, 14).Value, 9, 66)
                fieldtest = Value(Range("A1").Offset(x, 15).Value, 9, 71)
                fieldtest = Value(Range("A1").Offset(x, 16).Value, 12, 7)
                fieldtest = Value(Range("A1").Offset(x, 17).Value, 12, 15)
                fieldtest = Value(Range("A1").Offset(x, 18).Value, 12, 19)
                fieldtest = Value(Range("A1").Offset(x, 19).Value, 12, 23)
                fieldtest = Value(Range("A1").Offset(x, 20).Value, 12, 38)
                fieldtest = Value(Range("A1").Offset(x, 21).Value, 12, 44)
                fieldtest = Value(Range("A1").Offset(x, 22).Value, 12, 51)
                fieldtest = Value(Range("A1").Offset(x, 23).Value, 12, 57)
                fieldtest = Value(Range("A1").Offset(x, 24).Value, 12, 66)
                fieldtest = Value(Range("A1").Offset(x, 25).Value, 15, 41)
                MyScn.SendKeys ("<Enter>")
                Application.Wait (Now + TimeValue("0:00:03"))
                result2 = Trim(Sess0.Screen.GetString(1, 2, 78))
                If result2 <> "" Then
                    Sess0.Screen.MoveTo 1, 2
                    objWorkBook.Worksheets("TR22").Cells(x2, 27).Value = result2
                    '1.1 new change here:
                    objWorkBook.Worksheets("TR22").Cells(x2, 28).Value = Now()
                    strrange = "A" & x2 & ":AB" & x2
                    objWorkBook.Worksheets("TR22").Range(strrange).Select
                    With Selection.Interior
                        .ColorIndex = 3
                        .Pattern = xlSolid
                    End With
                    '*****
                    MyScn.SendKeys ("<PF12>")
                    MyScn.SendKeys ("<Enter>")
                    move2 = MyScn.WaitForCursorMove(6)
                    Application.Wait (Now + TimeValue("0:00:01"))
                Else
                    '1.1 new change here:
                    objWorkBook.Worksheets("TR22").Cells(x2, 27).Value = "Complete"
                    objWorkBook.Worksheets("TR22").Cells(x2, 28).Value = Now()
                    strrange = "A" & x2 & ":AB" & x2
                    objWorkBook.Worksheets("TR22").Range(strrange).Select
                    Selection.Interior.ColorIndex = xlNone
                    '*****
                    MyScn.SendKeys ("<PF12>")
                    MyScn.SendKeys ("<Enter>")
                    move2 = MyScn.WaitForCursorMove(1)
                    Application.Wait (Now + TimeValue("0:00:01"))
                End If
            Else
                Sess0.Screen.MoveTo 1, 2
                result = Sess0.Screen.GetString(1, 2, 78)
                objWorkBook.Worksheets("TR22").Cells(x2, 27).Value = result
                '1.1 new change here:
                objWorkBook.Worksheets("TR22").Cells(x2, 28).Value = Now()
                strrange = "A" & x2 & ":AB" & x2
                objWorkBook.Worksheets("TR22").Range(strrange).Select
                With Selection.Interior
                    .ColorIndex = 3
                    .Pattern = xlSolid
                End With
                '*****
                MyScn.SendKeys ("<PF4>")
                move = MyScn.WaitForCursorMove(21)
                Application.Wait (Now + TimeValue("0:00:01"))
                MyScn.PutString "22"
                Sess0.Screen.MoveTo 22, 80
                MyScn.PutString "S"
                MyScn.SendKeys ("<Enter>")
                move = MyScn.WaitForCursorMove(-15)
                Application.Wait (Now + TimeValue("0:00:01"))
            End If
        End If
    Next x

End Sub
Gimme some clues cause I'm stumped and this sucks.

 
MrMilson,

Why i had to put (-15) is that the cursor could be at row 22 on my screen but on the next screen, it would be row 7 and the only way waitforcursormove would work is that it remembers what the last screen row you were in (22) and I had to make it go back 15 rows so it would recognize row 7. Kind of backwards but I couldn't seem to get the WaitforCursor to work out right.
 
Thanks Skie for the suggestion. I did try it and it worked somewhat. I made some slight tweaks:
Code:
Sub WaitForRows(MoveRows)
    For i = 1 To 100
        If MyScn.Row = MoveRows Then Exit For
        Application.Wait (Now + TimeValue("0:00:01"))
    Next
End Sub
Chose to wait for the exact row position and just had it wait for it. Works great. Thanks for all the help! Excel doesn't freak out anymore when I close it.
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top