Failed to handle null or empty recordset in VB6 - vb6

It's been a day I've cracked my head to solve this....I've googled for solutions but none of it resolve my issue...
The code is like this:
Private Sub guh()
Dim oConn As Connection
Dim Record As Recordset
Dim SqlStr As String
SqlStr = "select * from dbo.Msg_History where Client_ID='2' AND Update_Msg='4'"
Set oConn = New Connection
With oConn
.CursorLocation = adUseClient
.CommandTimeout = 0
.Open "Provider=SQLOLEDB;Server=127.0.0.1;Initial Catalog=Table_Msg;UID=Admin;PWD="
End With
Set Record = oConn.Execute(SqlStr)
If IsNull(Record) Then
MsgBox "There are no records"
Else
MsgBox "There are records"
End If
oConn.Close
Set oConn = Nothing
End Sub
The sql statement is returning null recordset ..when i run the code...it always go to the "else" condition which is the line MsgBox "There are records"
I've tried change the line : If IsNull(Record) Then
to
If IsNull(Record.Fields(0).Value) Then
but then it throws an error like this:-
error: Either BOF or EOF is true, or the current record has been deleted. Requested operation requires a current record.
I've checked http://support.microsoft.com/kb/304267 and use eof and bof to the condition...n still get the same error..
please anyone help me...

I would use something like this:
' returns true if there is non empty recordset
Function isRSExists(rs) AS boolean
' has to exists as object
If Not rs Is Nothing Then
' has to be opened with recordset (could be empty)
If rs.State > 0 Then
' has to have some records
If Not rs.EOF Then
isRSExists = true
End If
End If
End If
End Function

Change this
If IsNull(Record) Then
to
If Record.RecordCount = 0 Then

I think you can test for if not Record.Eof.
If I recall correctly (it's been a long time), it only works with one type of cursor, I think it should be adUseServer. (EDIT No, it's actually RecordCount which has this problem)
I'll try and dig out some old code to check.

Thanks for the replies guys :D ...will test it later anyway...I havent's tested all of your suggestions at the time I'm posting this reply...I tested this: –
If Record.BOF And Record.EOF Then
and this works...

Related

ASP Classic "Microsoft VBScript runtime error '800a01a8' Object required: 'hashHelp'"

Here I have a double Directory that is suppose to be carrying information from a database in the form of the object hashHelp. Clearly, this isn't working.
Based on everything I've found on this website and around the web, this error message seems to imply that the object hashHelp isn't being created, but you can clearly see it being created above. I have check Any idea what could be happening?
do until rs.eof
if valid(cart, rs, data) = true then
Dim hashHelp
Set hashHelp = new HashHelper
hashHelp.setCode(rs.Fields("Code"))
hashHelp.setDateTime(rs.Fields("ScanTime"))
Dim entry
entry = DateDiff("d", beginDate, DateValue(rs.Fields("ScanTime")))
hash.Item(rs.Fields("ScanTime")).Item(arr(entry)) = hashHelp
arr(DateDiff("d", beginDate, rs.Fields("ScanTime"))) = arr(DateDiff("d", beginDate, rs.Fields("ScanTime"))) + 1
End If
rs.movenext
loop
rs.close
The line the error happens on is hash.Item(rs.Fields("ScanTime")).Item(arr(entry)) = hashHelp
I've checked all the other variable and they are being created and used just fine.

dbDenyWrite still in force after recordset closed

I have some code that gets a value from another table, then updates the value in the table. This code is in a loop that performs for each item in recordset based on another table. The code works the first time through but the next time it errors on the first line saying access is denied because the table is being held by another use or the user interface. The code uses DAO.
Anyone have a clue as to why the dbDenyWrite is still in force after closing the recordset and destroying its reference?
Here is a code snippet:
Set rsRR = DataDB.OpenRecordset("Railroads", dbOpenTable, dbDenyWrite)
rsRR.Index = "Railroads_RRIx"
rsRR.Seek "=", RTrs!RR
If rsRR.NoMatch Then
' Write ERROR MESSAGE
rsRR.Close
Set rsRR = Nothing
GoSub CleanUp
ReverseRouteDataCollect = 0
Exit Function
End If
If Not dWork Is Nothing Then Set dWork = Nothing
Set dWork = New Scripting.Dictionary
FieldsSave dWork, rsRR
i = FieldsCopy(drr, dWork, "TemplatesRailroad")
If dWork(rsRR.Name & "$LastWaybillNo") = "999999" Then
rsRR.Edit
rsRR!LastWaybillNo = 2001
rsRR.Update
Else
rsRR.Edit
rsRR!LastWaybillNo = dWork(rsRR.Name & "$LastWaybillNo") + 1
rsRR.Update
End If
rsRR.Close
Set rsRR = Nothing
.. why the dbDenyWrite is still in force after closing the recordset
and destroying its reference?
Because you only do this in case of a NoMatch.
So either change the dbDenyWrite to allow for edits, or (slower) reset the recordset before starting editing it:
Set rsRR = DataDB.OpenRecordset("Railroads", dbOpenTable)

VBS If file is open

I've got a simple program than scans data into a spreadsheet along with a timestamp, then you can either update the data by saving, or quit and exit and save.
The only issue I've been stuck on for a day or so is to work around the error handling of the case of the spreadsheet being already open. Id like to have something like this;
if file is open THEn msgbox("File is open, close file and start again")
WScript.Quit
Option Explicit
DIM oFs: Set oFs = CreateObject("Scripting.FileSystemObject")
DIM objExcel, strExcelPath, objSheet
DIM ib
DIM msg1
DIM msg2
strExcelPath = "c:\temp\Example.xls"
Set objExcel = CreateObject("Excel.Application")
objExcel.WorkBooks.Open strExcelPath
Set objSheet = objExcel.ActiveWorkbook.Worksheets(1)
DO
ib=inputbox("SCAN NAME, SCAN LOTS"&vbCrLf&"TO UPDATE,SCAN ""UPDATE."""&vbCrLf&"TO EXIT, SCAN ""QUIT.""","Picklot Passout Database")
IF ib="" THEN
msg1=MsgBox("You must scan either a NAME or LOT NUMBER."&vbCrLf&"If you want to exit, scan QUIT."&vbCrLf&"Click OK to continue.",vbokonly,"Cannot Insert Blank Data")
ELSEIF ib= "QUIT" OR ib= "quit" THEN
objExcel.ActiveWorkbook.Save
objExcel.ActiveWorkbook.Close
objExcel.Application.Quit
set objExcel = Nothing
Set oFs = Nothing
ELSEIF ib="update" OR ib="UPDATE" THEN
objExcel.ActiveWorkbook.Save
msg2=MsgBox("Update Complete.",vbokonly,"Database Updated")
ELSE
objSheet.Range("A2").EntireRow.Insert
objSheet.Cells(2, 1).Value = ib
objSheet.Cells(2, 2).Value=(now)
END IF
LOOP WHILE NOT ib="quit" AND NOT ib="QUIT"
This may help point you in the right direction. Sorry for the rushed, lowercase syntax and unconventional indentations (do not follow my bad practice - keep yours! :D), I wrote it in notepad you see - but it has been tested successfully.
Anyhow, with reference to your code, I have restructured it in a bad manner, familiar to me, adding the functionality you specify. Essentially the task manager application list is checked for a running instance of the "example" Excel file (depending on what version of excel you're using the syntax will differ).
If found it will make it the active window (thereby preventing a read only duplicate instance initiating). If no instance is found it will open "example.xlsx", in this case using a relative path to the script itself. A subroutine is then called to do the business with the cells...
I have written it in such a way to try keep your specs as well as maintain the "OK" and "Cancel" buttons explicitly functional. Please feel free to tinker with this, you may need to address the path and instr lines differently. I hope it helps! All the best.
path=createobject("scripting.filesystemobject").getparentfoldername(wscript.scriptfullname)
excelpath=path&"\example.xlsx"
set objword=createobject("word.application")
set coltasks=objword.tasks
i=0
for each objtask in coltasks
name=lcase(objtask.name)
if instr(name, "microsoft excel - example") then
i=1
end if
next
if i=1 then
wscript.echo "An active instance of ""example.xlsx"" has been found"
set objexcel=getobject(excelpath)
call UPDATER
else
set objexcel=createobject("excel.application")
objexcel.workbooks.open(excelpath)
set objsheet=objexcel.activeworkbook.worksheets(1)
objexcel.visible=true
call UPDATER
end if
sub UPDATER
do
data=inputbox("Please enter data" &vbcrlf&vbcrlf& "To save data & continue, type ""update""" &vbcrlf& "To save data & exit, type ""quit""","Excel DB Updater")
if isempty(data) then
objexcel.activeworkbook.close
objexcel.application.quit
wscript.quit()
elseif lcase(data)="quit" then
objexcel.activeworkbook.save
objexcel.activeworkbook.close
objexcel.application.quit
quit=msgbox("DB Updating complete",vbokonly,"Excel DB Updater")
wscript.quit
elseif lcase(data)="update" then
objexcel.activeworkbook.save
update=msgbox("Data save complete, press OK to continue",vbokonly,"Excel DB Updater")
elseif len(data)<>0 then
objsheet.range("A1").entirerow.insert
objsheet.cells(1, 1).value=data
objsheet.cells(1, 2).value=(now)
add=msgbox("Data added, press OK to continue",vbokonly,"Excel DB Updater")
end if
loop while len(data)>=0 and not lcase(data)="quit"
end sub

Outlook VBScript Expected Statement Error

I'm new to this site. I have searched thoroughly for an answer and cannot seem to locate an answer. I hope one of you fine people will be able to help me....
Thank you
When I try to run my custom form with code show below, I get the following message:
Script Error
Expected statement
Line No:33
Code:
Function Item_Open()
Dim LeaveItem
Dim IO
If not Connection_Open Then
MsgBox("Error connecting to SI")
LeaveItem = True
Item_Open = False
Else
Item_Open = False
End If
End Function
Function Item_Close()
If LeaveItem = True Then
Exit_Function
Else
End If
End Function
Subroutine Connection_Open()
Dim oSI
Set oSI = New ADODB.Connection
Dim ostrSI
oSI.ConnectionString = "Driver={Progress OpenEdge 10.1C Driver};HOST=192.168.1.1;DB=kob;UID=sii;PWD=sisys1;PORT=2501;"
oSI.Open
End Sub
Change
Subroutine Connection_Open()
to
Sub Connection_Open()

Crystal Reports in VB6 shows up empty for first run

So I'm having a problem with Crystal Reports where the first time I try to run the report, the report shows up empty. The report shows up with the various separators, lines, boxes, etc., but no data to fill in the report. I'm using Visual Basic 6 for the coding. I'm using a lot of inherited code and the code that handles the actual Crystal Reports is a file that is used for other reports and it works fine. So I'm sure the problem is from what I've done where I'm messing something up.
Here is the code I have so far:
Dim rs As ADODB.Recordset
Dim strRptFilePathTemp As String
Dim strRptFileName As String
Dim cSql As String
cSql = "SELECT * FROM TABLE1"
Set rs = DbConn.runStatement(cSql, "rs call", , , , , , , , , , True) 'gets a recordset based on the sql statement above
On Error GoTo ErrHandler
strRptFileName = "ReportName.rpt"
strRptFilePathTemp = App.Path
Screen.MousePointer = vbHourglass
Set frmcrystalreport.ReportRS = rs
DoEvents
frmcrystalreport.reportfile = strRptFilePathTemp & strRptFileName
frmcrystalreport.ReportTitle = _
frmCrystalReportsMainForm.GetRptTitle1("ReportTitle, ") & vbCrLf
gblStrReportFileNameLastRun = frmcrystalreport.reportfile
Screen.MousePointer = vbDefault
DoEvents
frmcrystalreport.Show vbModal
If Not frmcrystalreport.ReportRS Is Nothing Then
frmcrystalreport.ReportRS.Close
Set frmcrystalreport.ReportRS = Nothing
End If
Exit Sub
End If
End Sub
I've tried playing around with the DoEvents function to see if that can help but haven't had much luck with it. Everything works fine after that initial failed attempt at running the report. As long as I don't exit the program, it will print out a report with the valid data once I get passed that blank report. Thanks for any help you guys can give me.
Hmmm, it has been a while since I used VB6 and CR but I sort of remember that your need to discard the saved data before setting the viewers report source
Report.DiscardSavedData
CRViewer1.ReportSource = Report
Just figured out the problem after stumbling upon something in Crystal Reports. I had to turn off the save data with report feature in the report file under the File menu.

Resources