Vbscript Default Value from Database

Hello All,

This is an extension of a question here - https://www.experts-exchange.com/questions/29071843/Display-Query-Results-in-Message-Box.html

I'm trying to "cache" the results of the input box and re-use it on reload of the script.

My thought is this:

Is it possible to send the result of objRecordSet("ID") to a spreadsheet, then put that result from the spreadsheet as the default data in the input box?

So, the below code works fine. It populates the fields as it should but I want to send the objRecordSet("ID") to the
spreadsheet and retrieve it from the spreadsheet at reload of the script to be input box default value - see bold font I added that's not part of the original script.

So, in effect each ID the user enters in the input box will be the default value when they re-run the script.

If there's another way to do what I'm asking, I'm all ears! I hope this makes sense, thanks!


strKey = InputBox("Enter Person ID","Search", MyDefaultValue)
If strKey = "" then
Field1 = ""
Field2 = ""
on error resume next
Else
strConnection = "Provider=SQLOLEDB;Server=;Database=;User ID=;Password="
strSQL = "SELECT * FROM Table1 where ID LIKE '%" & strKey & "%' or User_Name LIKE '%" & strKey & "%'"
Set objConnection = CreateObject("ADODB.Connection")
objConnection.Open strConnection
Set objRecordSet = CreateObject("ADODB.Recordset")
objRecordSet.Open strSQL, objConnection, adLockReadOnly
do while objRecordSet.EOF = false
Field1 = objRecordSet("User_Name")
Field2 = objRecordSet("ID")
yourOutput = objRecordSet("User_Name")  & " - " & objRecordSet("ID") & vbcrlf
objRecordSet.MoveNext
loop
if yourOutput <> ""
-- Send objRecordSet("ID")to mypath/myspreadsheet/mycell (i.e., C:/Spreadsheets - Sheet1 - Cell A1)
-- MyDefaultValue = C:/Spreadsheets - Sheet1 - Cell A1
msgbox yourOutput
Else
msgbox "No records found."
Field1 = ""
Field2 = ""
End If
End If
LVL 1
tracymsAsked:
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

Bill PrewCommented:
Any reason you want to store this in a spreadsheet, rather than just a simple test file?  Feels like a much heavier solution than you need.


»bp
0
tracymsAuthor Commented:
No reason, I didn't know if there was a simpler solution. A test file sounds good, thanks!
0
Bill PrewCommented:
Small typo there, meant "text" file :-)


»bp
0
Ultimate Tool Kit for Technology Solution Provider

Broken down into practical pointers and step-by-step instructions, the IT Service Excellence Tool Kit delivers expert advice for technology solution providers. Get your free copy now.

Bill PrewCommented:
See if this gives you the idea.  I encapsulated the save and load activities into a couple of procedures for modularity.  And included a test procedure to give you an idea how I see them used.  You can add similar logic to your code to load and save the ID.

Sub Test()
    Dim s As String
    
    'Test reading ID when file doesn't exist
    s = "XX"
    s = LoadId("c:\temp\saveif.txt")
    Debug.Print "[" & s & "]"
    
    'Save an ID
    s = "ID2"
    Call SaveId("c:\temp\saveif.txt", s)
    
    'Test read ID from file
    s = ""
    s = LoadId("c:\temp\saveif.txt")
    Debug.Print "[" & s & "]"
End Sub

Sub SaveId(strPath As String, strId As String)
    Dim intFileNum As Integer
    intFileNum = FreeFile                   'Get a free file handle
    Open strPath For Output As intFileNum   'Open file for writing/overwriting
    Print #intFileNum, strId                'Write ID to file
    Close intFileNum                        'Close file
End Sub

Function LoadId(strPath As String) As String
    Dim intFileNum As Integer
    LoadId = ""                             'Default return is blank
    If Len(Dir(strPath)) = 0 Then           'If file does not exist, exit
        Exit Function
    End If
    intFileNum = FreeFile                   'Get a free file handle
    Open strPath For Input As intFileNum    'Open file for reading
    Line Input #intFileNum, LoadId          'Read first line to return
    Close intFileNum                        'Close file
End Function

Open in new window


»bp
0
tracymsAuthor Commented:
Thanks Bill, but I'm a layman so I went about searching more and this is as far as i got:

The below script creates a file and places the input text there. I saved it as test.vbs:

Dim objFSO 'File System Object
Set objFSO = CreateObject("Scripting.FileSystemObject")
Dim objTS 'Text Stream Object
Const ForWriting = 2
Set objTS = objFSO.OpenTextFile("C:\Users\UserName\Desktop\TextFile.txt", ForWriting, True)
objTS.Write(InputBox("Here it is"))
objTS.Close()

I don't know how to have the script read the contents of that file and have it populate the input box as the default value when I reopen it. So I suppose I'm looking to write the contents of the input box to a text file, then have the input box read that same file and place its contents in the input box as the default value.

Maybe if I get that to work, I can try to incorporate in my script...but I'm sure I'll need help doing that too.
0
Bill PrewCommented:
Did you explore my sample code, it shows how to write and later read back the text file.  Just use those routines in your code, one when you preload the form with the prior ID, and then the other when they enter the ID and you want to save it off.

No need for FileSystem object for this, can be done with the native VB file I/O support...


»bp
0
tracymsAuthor Commented:
Ok, I'm working with it. When I run your above code all by itself I get this error:

Microsoft VBScript compilation error: Expected end of statement

I removed the "As String" after "Dim s" and now it gives me another error:

Microsoft VBScript compilation error: Expected ')'
0
Bill PrewCommented:
Sorry, I thought you needed VBA code.  Here is an update that is VBS code you can build off of...

Option Explicit

' Define needed I/O constants
Const ForReading = 1
Const ForWriting = 2
Const TriStateUseDefault = -2

' Define global variables
Dim objFSO
Dim strFile
Dim strId

strFile = "b:\ee\ee29078846\saveit.txt"

' Create filesystm object
Set objFSO = CreateObject("Scripting.FileSystemObject")

'Test reading ID when file doesn't exist
strId = "XX"
strId = LoadId(strFile)
Wscript.Echo "[" & strId & "]"
    
'Save an ID
strId = "ID2"
Call SaveId(strFile, strId)
    
'Test read ID from file
strId = ""
strId = LoadId(strFile)
Wscript.Echo "[" & strId & "]"

Sub SaveId(strPath, strId)
    Dim objFile

    Set objFile = objFSO.OpenTextFile(strPath, ForWriting, True)
    objFile.WriteLine strId
    objFile.Close

    Set objFile = Nothing
End Sub

Function LoadId(strPath)
    Dim objFile

    LoadId = ""                             'Default return is blank

    If objFSO.FileExists(strPath) Then
        Set objFile = objFSO.OpenTextFile(strPath, ForReading, False, TriStateUseDefault)
        LoadId = objFile.ReadLine
        objFile.Close
    End If

    Set objFile = Nothing
End Function

Open in new window


»bp
0

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
tracymsAuthor Commented:
This is where I am so far - I think I'm close:

This pulls up the text file with the contents in the input box - this is doing what I want

*********************************************************
Dim objLSO 'File System
ObjectSet objLSO = CreateObject("Scripting.FileSystemObject")
Dim objLS 'Text Stream
ObjectConst ForReading = 1
Set objLS = objLSO.OpenTextFile("C:\Users\username\Desktop\TextFile.txt", ForReading)
strKey = objLS.ReadLine
Call InputBox("Enter Person ID or Name:","Search",strKey)
objLS.Close()
*********************************************************
 If strKey = "" then
 Field1 = ""
 Field2 = ""
 on error resume next
 Else
 strConnection = "Provider=SQLOLEDB;Server=;Database=;User ID=;Password="
 strSQL = "SELECT * FROM Table1 where ID LIKE '%" & strKey & "%' or User_Name LIKE '%" & strKey & "%'"
 Set objConnection = CreateObject("ADODB.Connection")
 objConnection.Open strConnection
 Set objRecordSet = CreateObject("ADODB.Recordset")
 objRecordSet.Open strSQL, objConnection, adLockReadOnly
 do while objRecordSet.EOF = false
 Field1 = objRecordSet("User_Name")
 Field2 = objRecordSet("ID")
 yourOutput = objRecordSet("User_Name")  & " - " & objRecordSet("ID") & vbcrlf
 objRecordSet.MoveNext
 loop
 if yourOutput <> ""
This is not writing back to the file - so when I put something different in the input box - it still reads what's already there instead of writing what I put in the input box:
*********************************************************
Dim objFSO 'File System Object
Set objFSO = CreateObject("Scripting.FileSystemObject")
Dim objTS 'Text Stream Object
Const ForWriting = 2
Set objTS = objFSO.OpenTextFile("C:\Users\username\Desktop\TextFile.txt", ForWriting, True)
objTS.Write(strKey)
objTS.Close()
*********************************************************
 msgbox yourOutput
 Else
 msgbox "No records found."
 Field1 = ""
 Field2 = ""
 End If
 End If
0
Bill PrewCommented:
If you want to sav yourOutput to the file then change this line:

objTS.Write(strKey)

to:

objTS.Write(yourOutput)


»bp
0
tracymsAuthor Commented:
GRRRR! I'm missing something -
This opens the file with the default value - but throws an error if its empty:

Dim objLSO 'File System
ObjectSet objLSO = CreateObject("Scripting.FileSystemObject")
Dim objLS 'Text Stream
ObjectConst ForReading = 1
Set objLS = objLSO.OpenTextFile("C:\Users\username\Desktop\TextFile.txt", ForReading)
strKey = objLS.ReadLine
Call InputBox("Enter Person ID or Name:","Search",strKey)
objLS.Close()

I put something in the file just to have it execute fully and it seems to be reading what's in the file. Now, when I backspace that value out of the input box and put in a new one to look up it goes straight to "file not found'.

If I put a known value (that's in the database) in the text file it will execute properly. This tells me that its reading what's in the file but not reading what I type in the input box.
0
tracymsAuthor Commented:
Also, I don't know how to properly incorporate your script into mine - I think I'm closer to the code I posted if I can get it working properly.
0
tracymsAuthor Commented:
I do think I want objTS.Write(strKey) written/saved to the file as that will be the database value. I'm sorry if I'm making more complicated - I'm still working on it and will post back any findings.
0
tracymsAuthor Commented:
I'm getting an error when the file is empty - "input past of end of file". I used on error resume next but wondering if there's a  more elegant solution or a way to continue even if the text file is empty? I hope to post my code sometime soon and if you don't mind giving it a look over...on the vbscript stuff as I tend to only focus on that it works! :-)


Dim objLSO 'File System Object
Set objLSO = CreateObject("Scripting.FileSystemObject")
Dim objLS 'Text Stream Object
Const strFileName = "C:\Users\username\Desktop\TextFile.txt"
Const ForReading = 1
If objLSO.FileExists("C:\Users\username\Desktop\TextFile.txt") then
Set objLS = objLSO.OpenTextFile(strFileName, ForReading)
on error resume next <-----
inContent = objLS.ReadLine
strKey = InputBox("Enter Person ID","Search", inContent)
objLS.Close()
End If
0
Bill PrewCommented:
You can test if the file is empty using:

If objLSO.FileExists("C:\Users\username\Desktop\TextFile.txt") Then
    Set objLS = objLSO.OpenTextFile(strFileName, ForReading)
    If objLS.AtEndOfStream Then
        inContent = ""
    Else
        inContent = objLS.ReadLine
    End If
    strKey = InputBox("Enter Person ID","Search", inContent)
    objLS.Close()
End If

Open in new window


»bp
0
tracymsAuthor Commented:
Great - that works, thanks!
0
tracymsAuthor Commented:
Ok, this is the entire code and is working. Thanks for your help! I find that it crashes intermittently (it was doing it before I modified the code) and not sure why. I tried wscript.quit at end of code in attempt to completely end code but get object required error. Any ideas?

Dim objLSO 'File System Object
Set objLSO = CreateObject("Scripting.FileSystemObject")
Dim objLS 'Text Stream Object
Const strFileName = "C:\Users\username\Desktop\TextFile.txt"
Const ForReading = 1
If objLSO.FileExists("C:\Users\username\Desktop\TextFile.txt") then
Set objLS = objLSO.OpenTextFile(strFileName, ForReading)
If objLS.AtEndOfStream Then
inContent = ""
Else
inContent = objLS.ReadLine
End If
strKey = InputBox("Enter Person ID","Search", inContent)
objLS.Close()
End If
If strKey = "" then
Field1 = ""
Field2 = ""
on error resume next
Else
strConnection = "Provider=SQLOLEDB;Server=;Database=;User ID=;Password="
strSQL = "SELECT * FROM Table1 where ID LIKE '%" & strKey & "%' or User_Name LIKE '%" & strKey & "%'"
Set objConnection = CreateObject("ADODB.Connection")
objConnection.Open strConnection
Set objRecordSet = CreateObject("ADODB.Recordset")
objRecordSet.Open strSQL, objConnection, adLockReadOnly
do while objRecordSet.EOF = false
Field1 = objRecordSet("User_Name")
Field2 = objRecordSet("ID")
yourOutput = objRecordSet("User_Name")  & " - " & objRecordSet("ID") & vbcrlf
getOutput = objRecordSet("ID")
objRecordSet.MoveNext
loop
if yourOutput <> "" then
msgbox yourOutput
Dim objFSO 'File System Object
 Set objFSO = CreateObject("Scripting.FileSystemObject")
 Dim objTS 'Text Stream Object
 Const ForWriting = 2
 Set objTS = objFSO.OpenTextFile("C:\Users\username\Desktop\TextFile.txt", ForWriting, True)
 objTS.Write(getOutput)
 objTS.Close()
Else
msgbox "No records found."
Field1 = ""
Field2 = ""
End If
End If

Open in new window

0
Bill PrewCommented:
A few small adjustments here, although I didn't see an obvious reason why it might  crash.  I removed the ON ERROR in case that was masking an error message.

Const ForReading = 1
Const ForWriting = 2

Const strFileName = "C:\Users\username\Desktop\TextFile.txt"

Set objLSO = CreateObject("Scripting.FileSystemObject")

If objLSO.FileExists(strFileName) Then
    Set objLS     = objLSO.OpenTextFile(strFileName, ForReading)

    If objLS.AtEndOfStream Then
        inContent = ""
    Else
        inContent = objLS.ReadLine
    End If

    objLS.Close()
End If

strKey = InputBox("Enter Person ID","Search", inContent)

If strKey = "" Then
    Field1 = ""
    Field2 = ""
Else
    strConnection     = "Provider=SQLOLEDB;Server=;Database=;User ID=;Password="
    strSQL            = "SELECT * FROM Table1 where ID LIKE '%" & strKey & "%' or User_Name LIKE '%" & strKey & "%'"
    Set objConnection = CreateObject("ADODB.Connection")
    objConnection.Open strConnection
    Set objRecordSet  = CreateObject("ADODB.Recordset")
    objRecordSet.Open strSQL, objConnection, adLockReadOnly

    Do While objRecordSet.EOF = False
        Field1     = objRecordSet("User_Name")
        Field2     = objRecordSet("ID")
        yourOutput = objRecordSet("User_Name") & " - " & objRecordSet("ID") & vbcrlf
        getOutput  = objRecordSet("ID")
        objRecordSet.MoveNext
    Loop

    If yourOutput <> "" Then
        MsgBox yourOutput
        Set objTS = objFSO.OpenTextFile(strFileName, ForWriting, True)
        objTS.Write(getOutput)
        objTS.Close()
    Else
        MsgBox "No records found."
        Field1 = ""
        Field2 = ""
    End If

End If

Open in new window


»bp
0
tracymsAuthor Commented:
Thanks Bill! I've managed to get it working as I needed. I found that it was crashing because the link that opens the application was being pushed/executed again when it had already been opened. So if I run the code, and input box is up - then I run the code again I get the error/crash.

Since the code is running within an application, users can click the link to active the code as many times as they like but it's supposed to be one at a time or after each process. This is why it was intermittent as the users testing it would make a mistake on occasion by clicking the link and not close the msgboxes. At least that's what I found to be the case. I don't know how to prevent that from happening aside from user training/awareness.

At any rate, the full working code is below with a few more adjustments to add to yours. Thanks again!


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

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


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

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

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

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

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

[b]' If ID entered, look up against database[/b]
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

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

[b]' Declare variable for msgbox [/b]
yourOutput =  objRecordSet("ID") & vbNewLine &  objRecordSet("Full_Name") 

[b]' Declare variable for input box default value[/b]
getOutput = objRecordSet("ID")

objRecordSet.MoveNext
loop

[b]' 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[/b]

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

[b]' If no match found
' msgbox, close database
' set applications fields to empty[/b]

Else

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

Open in new window

0
tracymsAuthor Commented:
0
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Programming

From novice to tech pro — start learning today.

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.