Help closing a loop in VBScript

[danswear]

I need some assistance with VBScript. The script is used for a AS/400 and it is set up to pull accounts out of access and pull the account up in the AS/400. It was set up to just zero out an account, however, I added the function of pulling a specific amount out of access and inputing that number into the AS/400 account. My problem is that when I added, vdollaramt = vamt(vloop4), into the Startit subroutine below it now just loops through the list of accounts and then repeats, without performing the steps in the Writeit subroutine. Can anyone help fix my code?


[PCOMM SCRIPT HEADER]
LANGUAGE=VBSCRIPT
DESCRIPTION=
[PCOMM SCRIPT SOURCE]
OPTION EXPLICIT

Dim VDB
Dim VDBLOC
Dim Connect
Dim vcomment

VDB = "SDCBAdjust.mdb"
VDBLOC = "c:\database\"

' Sets the Database info
set Connect = CreateObject("ADODB.connection")
Connect.connectionstring = "Provider=microsoft.jet.oledb.4.0;User ID= Admin; Data Source=" & VDBLOC & VDB
Connect.Open


Dim VCard(101)
Dim VCurrentCard
Dim VCurrentID
Dim vdollaramt
Dim vamt(101)
Dim VAMount
Dim VReason
dim vlastinfo
Dim VName
dim VEnterby
Dim VIDno(101)


autECLSession.SetConnectionByName(ThisSessionName)

Call Clearcard
Call Declare
Call GetCards



Sub Declare()

VReason = "SDCB Adjustment"
'31642
vEnterby = inputbox("Put In Your Enterby.", "Put In Your Enterby", "")
'vamount = inputbox("Amount to Adjust", "Put In Your Adjustment", Vamount)
VReason = inputbox("What is the Reason" & vbCrlf & "25 characters or less", "Put In Your Reason", VReason)
vreason = ucase(VReason)
vreason = left(vreason,25)
vlastinfo = "Start"

End Sub

Sub Clearcard()
Dim vloop
vloop = 0
Do until vloop = 100
vcard(vloop) = ""
vidno(vloop) = ""
vamt(vloop) = ""
vloop = vloop + 1
Loop
vcard(101) = "END"
End Sub



Sub GetCards()

Dim VSql
Dim VResp
Dim VTemp
Dim Results
Dim vloop


VSql = "SELECT * FROM qMain"
Set Results = Connect.Execute(VSQL)

If results.eof = True And results.bof = True Then
msgbox("No Records To Run")
Else
results.movefirst
vloop = 1

Do until vloop = 101 Or results.eof = True
Vcard(vloop) = Results.Fields("GuestID").Value
VIDNo(vloop) = Results.Fields("IDNo").Value
vamt(vloop) = Results.Fields("ADJ").Value
results.movenext
vloop = vloop + 1
Loop

If trim(autECLSession.autECLPS.GetText(1,27,25)) = "TOTAL REWARDS MENU" Then
Call Startit

Else
MSGBOX("WRONG SCREEN")
Exit Sub
End If


End If


End Sub

Sub Startit()
Dim Vloop4
Dim VResp

vloop4 = 1


Do until vloop4 = 101 Or Vcard(vloop4) = ""

vcurrentcard = vcard(vloop4)
vcurrentid = vidno(vloop4)
vdollaramt = vamt(vloop4)

If vresp = "x" Then
Exit Sub
Else
Call Runit1
End If

vloop4 = vloop4 + 1
Loop


Call Clearcard
Call GetCards

End Sub


Sub Runit1()
Dim verror

autECLSession.autECLOIA.WaitForAppAvailable
autECLSession.autECLOIA.WaitForInputReady

autECLSession.autECLPS.SendKeys "10", 20, 19
autECLSession.autECLPS.SendKeys venterby, 20, 50
autECLSession.autECLPS.SendKeys vcurrentcard & "[field+]", 21, 19

autECLSession.autECLOIA.WaitForInputReady
autECLSession.autECLPS.SendKeys "[ENTER]"

autECLSession.autECLOIA.WaitForAppAvailable
autECLSession.autECLOIA.WaitForInputReady


verror = ""

Do until trim(autECLSession.autECLPS.GetText(1,30,25)) = "ENTER CASH ADJUSTMENT"


If trim(autECLSession.autECLPS.GetText(1,30,25)) = "PRIORITY MESSAGES" Then autECLSession.autECLPS.SendKeys "[ENTER]"
autECLSession.autECLOIA.WaitForAppAvailable
autECLSession.autECLOIA.WaitForInputReady

If trim(autECLSession.autECLPS.GetText(1,30,25)) = "ENTER CASH ADJUSTMENT" Then
verror = "NOT ALLOWED"
vname = "error"
vdollaramt = "0"
Exit Do
End If
Loop


If verror <> "NOT ALLOWED" Then

If trim(autECLSession.autECLPS.GetText(1,30,25)) <> "ENTER CASH ADJUSTMENT" Then
MSGBOX("WRONG SCREEN")
Exit Sub
End If


vamount = vdollaramt
autECLSession.autECLPS.SendKeys "s", 15, 39
autECLSession.autECLPS.SendKeys vamount, 16, 39
autECLSession.autECLPS.SendKeys vreason, 17, 39
autECLSession.autECLPS.SendKeys vEnterby , 18, 39
vname = trim(autECLSession.autECLPS.GetText(5,14,40))



If vamount = 0 Then
autECLSession.autECLPS.SendKeys "[pf1]"
Else

autECLSession.autECLPS.SendKeys vamount & "[field+]", 16, 39
''Replace with Enter
autECLSession.autECLPS.SendKeys "[enter]"
End If
End If

autECLSession.autECLOIA.WaitForAppAvailable
autECLSession.autECLOIA.WaitForInputReady


If trim(autECLSession.autECLPS.GetText(24,2,39)) = "Adj amt greater than patron daily limit" Then


autECLSession.autECLPS.SendKeys vEnterby , 20, 39
autECLSession.autECLPS.SendKeys "[pf24]"

autECLSession.autECLOIA.WaitForAppAvailable
autECLSession.autECLOIA.WaitForInputReady
End If

vcomment = ""
If verror = "NOT ALLOWED" Then vcomment = "No Allowed"

If trim(autECLSession.autECLPS.GetText(24,2,18)) = "No Cash Adjustment" Then vcomment = "No Adj"

If instr(1, trim(autECLSession.autECLPS.GetText(24,1,50)), "Cash SUBTRACTED") <> "0" Then vcomment = "OK"

Call writeit
End Sub


Sub Writeit()
Dim VSQL

vsql = "UPDATE tblmain SET Entered = -1, DT = '" & Now & "', comment = '" & vcomment & "', gname = '" & vname & "' WHERE IDno=" & vcurrentid & vamount & ";"
'msgbox(vsql)
connect.execute (vsql)

VAmount = ""
vlastinfo = vname
vname = ""

End Sub

 

[danswear]

Got it! It was the vsql statement.

 

[EBGreen]

Might I suggest proper indentation in the future to avoid such issues?

[red]"... isn't sanity really just a one trick pony anyway?! I mean, all you get is one trick, rational thinking, but when you are good and crazy, oooh, oooh, oooh, the sky is the limit!" - The Tick[/red]