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.
Gimme some clues cause I'm stumped and this sucks.
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