Groups > microsoft.public.scripting.vbscript > #12409

The Pipe is Being Closed

Newsgroups	microsoft.public.scripting.vbscript
Date	2022-02-09 07:41 -0800
Message-ID	<5091ef40-e2f4-4c94-8007-22002257c5bbn@googlegroups.com> (permalink)
Subject	The Pipe is Being Closed
From	Mike Bond <mikebondox@gmail.com>

Show all headers | View raw

I am running the following code and after my get file via MSHTA, it locks up and I get a script error. Confusing thing is... not everyone that uses this gets the error and some people can run it, no problem. Any assistance would be great!

#$language = "VBScript"
#$interface = "1.0"

'Global vars
g_continue = True
g_checkout = False


Sub Main

securityCheckInput = LCase(InputBox("Please enter property code:","ZZ Wholesaler Audit"))
If securityCheckInput = "" Then : Exit Sub : End If 
	
sBegin = MsgBox("To proceed, select OSTAT report...", vbOKCancel + vbQuestion, "Check Out ZZ (Wholesaler)")
IF sBegin = vbCancel Then
Exit Sub
End IF

Option Explicit

Dim strFile

strFile = SelectFile( )

If strFile = "" Then
    WScript.Echo "No file selected."
Else
    WScript.Echo """" & strFile & """"
End If
	referencefile = SelectFile()
	If referencefile = "" Then
	Exit Sub
	End If

Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objTextFileInput = objFSO.OpenTextFile(referencefile,True)
strInputFile = objTextFileInput.ReadAll
objTextFileInput.Close
inputLines = Split(strInputFile, vbcrlf)

'Check config/(check excel)
Set WshShell = CreateObject("WScript.Shell")
On Error Resume Next
Set xl = GetObject(, "Excel.Application")
	If Err AND Err.Number = 429 Then
		ExcelOpen = False
	Else
		ExcelOpen = True
	End If
	On Error Goto 0
		If NOT ExcelOpen Then
			Set objExcel = CreateObject("Excel.Application")
		Else
			Set objExcel = GetObject(,"Excel.Application")
		End If
config = WshShell.CurrentDirectory & "\Wholesaler CO.xlsm"
	With objExcel
		.Application.Visible = True
		.ScreenUpdating = True
		.DisplayAlerts = False
		Set objWorkbook = .Workbooks.Open((config))
		objWorkbook.Worksheets("OTA Catalogue").Activate
	End With

'Pull OTA segments from list. starts @ line 6 in excel
EMPLOYEENUMBER = objExcel.Cells(2, 2). Value
PROPERTYCODE = LCase(objExcel.Cells(3, 2). Value)
Set lOTA = CreateObject("System.Collections.ArrayList")
row_excel = 6
Do Until objExcel.Cells(row_excel, 1). Value = ""
lOTA.Add objExcel.Cells(row_excel, 1) & ";" & objExcel.Cells(row_excel, 2)
row_excel = row_excel + 1
Loop
'For each item in lOTA
'msgbox item
'Next

'Security Check - matches typed property code to excel doc's
If NOT securityCheckInput = PROPERTYCODE Then : msgbox "ERROR: Property Code does not match" : Exit Sub : End If

'Iterate thru
For each strLine in inputLines
resnum = left(strLine, 6)
zzcheck = mid(strLine, 29, 2)
If IsNumeric(resnum) AND zzcheck = "ZZ" Then
	For each item in lOTA
	spl_segment = split(item, ";")
	If Trim(Mid(strLine, 19,8)) = spl_segment(0) Then
		'Return to MOHOMAIN/MOFOMAIN
		Do Until crt.Screen.Get(1,53,1,54) = "MO" And crt.Screen.Get(1,57,1,60) = "MAIN"
		crt.Screen.Send vbcr
		Loop
			crt.sleep 100
			If crt.Screen.Get(1,55,1,56) = "FO" Then
			crt.Screen.Send "10 4" & vbcr
			ElseIf crt.Screen.Get(1,55,1,56) = "HO" Then
			crt.Screen.Send "1 10 4" & vbcr
			End If
		'Credit Auth Entry
		Call checkScreen("C=CONF#):",resnum)
		waitUntil("ENTER SELECTION (1=PMT METHOD, 2=D/B ACCT NUMBER, 3=BOTH):")
		currentBalance = Trim(crt.screen.get(7,65,7,78))
		If onScreen("ACCOUNTING TO REVIEW") Or currentBalance = ".00" Then
		'check for manual audit flag
'msgbox "acct to review or current bal = 0"
			cSe("")
		Else
		'continue otherwise
			Call checkScreen("3=BOTH):","3")
			Call checkScreen("ENTER METHOD OF PAYMENT","DB                          ")
			Call checkScreen("ENTER CUSTOMER ID:",spl_segment(1))
'msgbox "DB enabled"
			Call waitUntilOnScreen2("CORRECT CUSTOMER ID? (Y/N):","CUSTOMER ID NOT FOUND, PRESS <ENTER>")
			If onScreen("(Y/N):") Then
				Call checkScreen("IS THIS THE CORRECT CUSTOMER ID? (Y/N):","y")
					Do Until crt.Screen.Get(1,53,1,54) = "MO" And crt.Screen.Get(1,57,1,60) = "MAIN"
					crt.Screen.Send vbcr
					Loop
						crt.sleep 100
						If crt.Screen.Get(1,55,1,56) = "FO" Then
						crt.Screen.Send "2 1" & vbcr
						ElseIf crt.Screen.Get(1,55,1,56) = "HO" Then
						crt.Screen.Send "1 2 1" & vbcr
						End If
				Call checkScreen("OR OPTION:",resnum)
				waitUntil("OR LINE#:")
				If NOT onScreen("ACCOUNTING TO REVIEW") Then
					Call checkScreen("OR LINE#:","a")
					Call waitUntilOnScreen2("SHIFT NUMBER:","(R)EGISTRATION")
					If onScreen("SHIFT NUMBER:") Then : cSe("3") : End If
					Call checkScreen("(R)EGISTRATION","12")
					crt.sleep 300
					Call waitUntilOnScreen2("(P)=POST","(R)EGISTRATION")
					
					Do Until NOT g_continue
					Call AuditFolio
					If g_continue Then : cSe("") : crt.sleep 250 : End If
					Loop
					
					If g_checkout Then
					If onScreen("(P)=POST") Then : cSe("p") : End If
					Call checkScreen("ENTER:","1")
					Call waitUntilOnScreen2("!! EARLY OR LATE DEPARTURE !!  PRESS ENTER.","ENTER YOUR EMPLOYEE NUMBER:")
					If onScreen("!! EARLY OR LATE DEPARTURE !!  PRESS ENTER.") Then : cSe("") : End If
					Call checkScreen("ENTER YOUR EMPLOYEE NUMBER:",EMPLOYEENUMBER)
'sChargeENTER = MsgBox("OK to proceed with charging, cancel to exit", vbOKCancel + vbQuestion, resnum & " complete")
'IF sChargeENTER = vbCancel Then : Exit Sub : End IF
					Call checkScreen("IF PAID IN FULL:","33")
'sContinueENTER = MsgBox("goto next?? (cancel to view account)", vbOKCancel + vbQuestion, resnum & " complete")
'IF sContinueENTER = vbCancel Then : cSe("a") : Exit Sub : End IF
					End If
				Else
'msgbox "manual audit flag"
					cSe("")
					
				End If
				
				'sContinue = MsgBox("proceed to next??", vbOKCancel + vbQuestion, "complete")
				'IF sContinue = vbCancel Then : Exit Sub : End IF
				
			Else
			msgbox "Invalid DB Account, process terminated. Please verify correct DB account listed in Excel file."
			Exit Sub
			End If
		End If
		
	End If
	Next
End If

g_continue = True
g_checkout = False

Next

msgbox("Complete!")

objExcel.Quit
Set objExcel = Nothing

End Sub


'Sub Func
Function AuditFolio
For counter = 9 To 17
	auditline = Trim(crt.Screen.Get(counter,15,counter,22))
	Select Case auditline
	
	Case "ROOMS TR","STATE TX","CITY TAX","SCR FEE","ROOM PKG","ROOM"
		'do nothing
'msgbox auditline & " found"
		
		Case "TELECOMM"
'msgbox auditline & " found, check for 0$"
		If NOT crt.Screen.Get(counter,49,counter,52) = " .00" Then
			If onScreen("(P)=POST") Then : cSe("p") : End If
			Call checkScreen("ENTER:", "")
			Call checkScreen("OR LINE#:", "10")
			Call checkScreen("<\D>ONE", "ACCOUNTING TO REVIEW     ")
			crt.sleep 250
'msgbox "accounting to review"
			Call checkScreen("<\D>ONE", "\d")
			g_continue = False
			Exit Function
		End If
			
		Case ""
'msgbox auditline & "blank line found - exit"
		g_continue = False
		g_checkout = True
		Exit Function
		
		Case "DIR BILL"
'msgbox auditline & " found"
		g_continue = False
		g_checkout = False
		Exit Function
		
		Case "CASH"
'msgbox auditline & " found"
			If auditline = "CASH" AND crt.Screen.Get(counter,49,counter,52) = " .00" AND counter = 17 AND onScreen("(R)EGISTRATION") Then
				screentest = crt.screen.get(counter,5,counter,7)
				cSe("12")
				crt.sleep 250
				screentest2 = crt.screen.get(counter,5,counter,7)
				If screentest2 = screentest Then
					g_continue = False
					g_checkout = True
					Exit Function
				End If
			Else
				g_continue = True
			End If
			
		Case Else
			If onScreen("(P)=POST") Then : cSe("p") : End If
			Call checkScreen("ENTER:", "")
			Call checkScreen("OR LINE#:", "10")
			Call checkScreen("<\D>ONE", "ACCOUNTING TO REVIEW     ")
			crt.sleep 250
'msgbox "accounting to review"
			Call checkScreen("<\D>ONE", "\d")
			g_continue = False
			Exit Function
			'MsgBox counter & " " & auditline & " error"

		End Select
next
End Function

'==FUNCTIONS==
Function SelectFile( )
    Dim objExec, strMSHTA, wshShell

    SelectFile = ""

    strMSHTA = "mshta.exe ""about:" & "<" & "input type=file id=FILE>" _
             & "<" & "script>FILE.click();new ActiveXObject('Scripting.FileSystemObject')" _
             & ".GetStandardStream(1).WriteLine(FILE.value);close();resizeTo(0,0);" & "<" & "/script>"""
			 
    Set wshShell = CreateObject( "WScript.Shell" )
    Set objExec = wshShell.Exec( strMSHTA )

    SelectFile = objExec.StdOut.ReadLine

    Set objExec = Nothing
    Set wshShell = Nothing
End Function

Function waitUntilOnScreen2(tree1,tree2)
	Do Until onScreen(tree1) OR onScreen(tree2)
	crt.sleep 120
	Loop
End Function

Function cSe(var)
crt.Screen.Send var & vbcr : crt.sleep 50
End Function

Function checkScreen(test, send)
Do Until InStr(crt.Screen.Get2(1,1,24,80), test) : crt.sleep 100 : Loop
	crt.Screen.Send send & vbcr
End Function

Function onScreen(var)
onScreen = False
If InStr(crt.Screen.Get2(1,1,24,80), var) Then : onScreen = True : End If
End Function

Function waitUntil(var)
Do Until onScreen(var) : crt.sleep 100 : Loop
End Function

Back to microsoft.public.scripting.vbscript | Previous | Next — Next in thread | Find similar

Thread

The Pipe is Being Closed Mike Bond <mikebondox@gmail.com> - 2022-02-09 07:41 -0800
  Re: The Pipe is Being Closed JJ <jj4public@gmail.com> - 2022-02-10 16:14 +0700

csiph-web