• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 78
  • Last Modified:

InputBox Loop

How can I modify this code to have the input box continue to pop up (loop) so it stays visible. I only want the script to end if the user hits the cancel button on the input box.

' Declare variables/constants once
Const ForReading = 1
Const ForWriting = 2
Dim objFSO 'File System Object
Dim objTS 'Text Stream Object
Set objFSO = CreateObject("Scripting.FileSystemObject")

' Get current logged in username for path
strFileName = "C:\Users\" & createobject("wscript.shell").expandenvironmentstrings("%username%") & "\Desktop\TextFile.txt"


' Check if file exists, if not create it
If Not objFSO.FileExists(strFileName) then
Set oTxtFile = objFSO.CreateTextFile("C:\Users\" & createobject("wscript.shell").expandenvironmentstrings("%username%") & "\Desktop\TextFile.txt") 
oTxtFile.Close
End If

' Open file for reading
If objFSO.FileExists(strFileName) then
Set objTS = objFSO.OpenTextFile(strFileName, ForReading)

' create variable to hold default value
If objTS.AtEndOfStream Then
inContent = ""
Else
inContent = objTS.ReadLine
End If

' Add default value to input box
strKey = InputBox("Enter Person ID (7 digit)","Search", inContent)
objTS.Close()
End If

' If input box empty, make application fields empty
If strKey = "" then
Field1 = ""
Field2 = ""
msgbox "No data entered or you selected Cancel."

' If ID entered, look up against database
Else
strConnection = "Provider=SQLOLEDB;Server=;Database=;User ID=;Password="
strSQL = "SELECT * FROM Table_Name where [ID]  = '" & strKey & "'" 
Set objConnection = CreateObject("ADODB.Connection")
objConnection.Open strConnection
Set objRecordSet = CreateObject("ADODB.Recordset")
objRecordSet.Open strSQL, objConnection, adLockReadOnly
do while objRecordSet.EOF = false

' Set Field 1 and 2 of application 
' to hold data from database
Field1 = objRecordSet("Full_Name")
Field2 = objRecordSet("ID") 

' Declare variable for msgbox 
yourOutput =  objRecordSet("ID") & vbNewLine &  objRecordSet("Full_Name") 

' Declare variable for input box default value
getOutput = objRecordSet("ID")

objRecordSet.MoveNext
loop

' If database match found
' msgbox results
' add results to applications fields 1 and 2 
' add ID to text file to use as default value in input box

if yourOutput <> "" then
msgbox yourOutput
Set objTS = objFSO.OpenTextFile(strFileName, ForWriting)
objTS.Write(getOutput)
objTS.Close()

' If no match found
' msgbox, close database
' set applications fields to empty

Else

objRecordSet.Close
Set objRecordSet=Nothing
objConnection.Close
msgbox "No records found."
Field1 = ""
Field2 = ""
End If
End If

Open in new window

0
tracyms
Asked:
tracyms
  • 4
  • 2
1 Solution
 
Bill PrewCommented:
Just wrap the code you want to loop in a DO WHILE or DO UNTIL loop, should be straight forward.  Just make sure you are initializing variables as needed in the loop, etc.

VBScript Loops


»bp
0
 
Bill PrewCommented:
For example you might want to do these only once outside the loop, since they are only needed once and will slow things down inside the loop...

strConnection = "Provider=SQLOLEDB;Server=;Database=;User ID=;Password="
Set objConnection = CreateObject("ADODB.Connection")
objConnection.Open strConnection
Set objRecordSet = CreateObject("ADODB.Recordset")
. . .
Set objRecordSet=Nothing
objConnection.Close



»bp
0
 
tracymsAuthor Commented:
I already have a do while loop - if I move the "loop" part to the end of the code I get an error "loop without do"


' Declare variables/constants once
Const ForReading = 1
Const ForWriting = 2
Dim objFSO 'File System Object
Dim objTS 'Text Stream Object
Set objFSO = CreateObject("Scripting.FileSystemObject")

' Get current logged in username for path
strFileName = "C:\Users\" & createobject("wscript.shell").expandenvironmentstrings("%username%") & "\Desktop\TextFile.txt"


' Check if file exists, if not create it
If Not objFSO.FileExists(strFileName) then
Set oTxtFile = objFSO.CreateTextFile("C:\Users\" & createobject("wscript.shell").expandenvironmentstrings("%username%") & "\Desktop\TextFile.txt")
oTxtFile.Close
End If

' Open file for reading
If objFSO.FileExists(strFileName) then
Set objTS = objFSO.OpenTextFile(strFileName, ForReading)

' create variable to hold default value
If objTS.AtEndOfStream Then
inContent = ""
Else
inContent = objTS.ReadLine
End If

' Add default value to input box
strKey = InputBox("Enter Person ID (7 digit)","Search", inContent)
objTS.Close()
End If

' If input box empty, make application fields empty
If strKey = "" then
Field1 = ""
Field2 = ""
msgbox "No data entered or you selected Cancel."

' If ID entered, look up against database
Else
This is already outside the loop
************************************************
strConnection = "Provider=SQLOLEDB;Server=;Database=;User ID=;Password="
strSQL = "SELECT * FROM Table_Name where [ID]  = '" & strKey & "'"
Set objConnection = CreateObject("ADODB.Connection")
objConnection.Open strConnection
Set objRecordSet = CreateObject("ADODB.Recordset")
objRecordSet.Open strSQL, objConnection, adLockReadOnly
************************************************
do while objRecordSet.EOF = false

' Set Field 1 and 2 of application
' to hold data from database
Field1 = objRecordSet("Full_Name")
Field2 = objRecordSet("ID")

' Declare variable for msgbox
yourOutput =  objRecordSet("ID") & vbNewLine &  objRecordSet("Full_Name")

' Declare variable for input box default value
getOutput = objRecordSet("ID")

objRecordSet.MoveNext


' If database match found
' msgbox results
' add results to applications fields 1 and 2
' add ID to text file to use as default value in input box

if yourOutput <> "" then
msgbox yourOutput
Set objTS = objFSO.OpenTextFile(strFileName, ForWriting)
objTS.Write(getOutput)
objTS.Close()

' If no match found
' msgbox, close database
' set applications fields to empty


objRecordSet.Close
Set objRecordSet=Nothing
objConnection.Close
msgbox "No records found."
Field1 = ""
Field2 = ""
Moved loop here and got message "loop without do"
loop

End If
End If
0
Keep up with what's happening at Experts Exchange!

Sign up to receive Decoded, a new monthly digest with product updates, feature release info, continuing education opportunities, and more.

 
Bill PrewCommented:
I was thinking something like this:

' Declare variables/constants once
Const ForReading = 1
Const ForWriting = 2

Dim objFSO 'File System Object
Dim objTS 'Text Stream Object

Set objFSO = CreateObject("Scripting.FileSystemObject")

' Get current logged in username for path
strUser = CreateObject("Wscript.Shell").ExpandEnvironmentStrings("%USERNAME%")
strFileName = "C:\Users\" & strUser & "\Desktop\TextFile.txt"

' Check if file exists, if not create it
If Not objFSO.FileExists(strFileName) Then
    Set oTxtFile = objFSO.CreateTextFile(strFileName) 
    oTxtFile.Close
End If

' Open file for reading
If objFSO.FileExists(strFileName) Then
    Set objTS = objFSO.OpenTextFile(strFileName, ForReading)

    ' create variable to hold default value
    If objTS.AtEndOfStream Then
        inContent = ""
    Else
        inContent = objTS.ReadLine
    End If

    objTS.Close()

End If

strConnection = "Provider=SQLOLEDB;Server=;Database=;User ID=;Password="
Set objConnection = CreateObject("ADODB.Connection")
objConnection.Open strConnection
Set objRecordSet = CreateObject("ADODB.Recordset")

UserCancel = False
Do Until UserCancel

    ' Add default value to input box
    strKey = InputBox("Enter Person ID (7 digit)","Search", inContent)

    ' If input box empty, make application fields empty
    If strKey = "" then
        UserCancel = True
        Field1 = ""
        Field2 = ""
        msgbox "No data entered or you selected Cancel."

    Else
        ' If ID entered, look up against database
        strSQL = "SELECT * FROM Table_Name where [ID]  = '" & strKey & "'" 
        objRecordSet.Open strSQL, objConnection, adLockReadOnly
        do while objRecordSet.EOF = false

            ' Set Field 1 and 2 of application 
            ' to hold data from database
            Field1 = objRecordSet("Full_Name")
            Field2 = objRecordSet("ID") 

            ' Declare variable for msgbox 
            yourOutput =  objRecordSet("ID") & vbNewLine &  objRecordSet("Full_Name") 
        
            ' Declare variable for input box default value
            getOutput = objRecordSet("ID")

            objRecordSet.MoveNext
        loop

        ' If database match found
        ' msgbox results
        ' add results to applications fields 1 and 2 
        ' add ID to text file to use as default value in input box

        if yourOutput <> "" then
            msgbox yourOutput
            Set objTS = objFSO.OpenTextFile(strFileName, ForWriting)
            objTS.Write(getOutput)
            objTS.Close()

            ' If no match found
            ' msgbox, close database
            ' set applications fields to empty

        Else

            msgbox "No records found."
            Field1 = ""
            Field2 = ""
        End If
    End If

Loop

objRecordSet.Close
objConnection.Close

Open in new window


»bp
0
 
tracymsAuthor Commented:
Thanks Bill,

This looped but didn't pass the variables to the fields before looping. The app keeps crashing and I think its the app itself. Any time I run the code more than once it crashes, hence trying the loop so it doesn't have to re-run each time.

I tried a solution here posted by h pic to kill the process if it's already running but the app still crashed:
https://stackoverflow.com/questions/7849699/how-to-check-vbs-script-in-windows-is-running-or-not

At this point I think its a limitation of the app as while it says you can customize with vbscript language it isn't very robust. I'm looking at another approach using either an HTA as the front end for the script (wrap code in HTA front end and have my app read the values from the text file) or querying an excel file instead of the database.

Thanks again for your help!
0
 
Bill PrewCommented:
Sorry that didn't work out better for you, but thanks for the feedback.


»bp
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

Join & Write a Comment

Featured Post

Cloud Class® Course: MCSA MCSE Windows Server 2012

This course teaches how to install and configure Windows Server 2012 R2.  It is the first step on your path to becoming a Microsoft Certified Solutions Expert (MCSE).

  • 4
  • 2
Tackle projects and never again get stuck behind a technical roadblock.
Join Now