Increasing execution time of query in recordset (CursorLocation ) - vb6

I am using below code to retrieve data from table.
After that i am binding resultant data to grid.
Problem is with speed.This query taking almost 2 to 3 minute to execute wherease from backend it takes 30 to 40 seconds.
-----------Current Code ------------------
rs.ActiveConnection = con //con is connection
con.Errors.Clear
rs.CursorLocation = adUseServer
rs.CursorType = adOpenDynamic
rs.LockType = adLockOptimistic
rs.StayInSync = True
On Error Resume Next
rs.Open strCmd //strCmd is query
------- Alternate solution I tried using Client ---------------
rs.ActiveConnection = con //con is connection
con.Errors.Clear
rs.CursorLocation = adUseClient
rs.CursorType = adOpenKeyset
rs.LockType = adLockBatchOptimistic
rs.StayInSync = True
On Error Resume Next
rs.Open strCmd //strCmd is query
/// Result : Same speed
--------Alternate solution using Execute rather than Open recodset ---------------
com.ActiveConnection = con //con is connection
com.CommandType = adCmdText
com.CommandTimeout = 500
com.CommandText = strCmd //strCmd is query
con.Errors.Clear
On Error Resume Next
Set rs= com.Execute()
//Result :Speed is fast but when I try to update value in grid it is showing bellow error :
"Run-time error '3251': Current Recordset does not support
updating.This may be a limitation of the provider,or of the selected
locktype."

I think it's probably your table(s) setup / query, and not your connection that's causing the issues.
Make sure that every field listed in the WHERE, JOIN, & ORDER BY clauses are indexed.
Reevaluate any derived fields you are creating. I saw a query the other day that combined 2 text fields and then sorted on that new, -unindexed-, field.
If you post your query and your table structure, it will give me a better idea.

Related

Access 2010 - Run-time error 3022

I'm trying to add records to an exisiting table called "Topics" (section as of "For Each SelectedTopic In SelectedTopicsCtl.ItemsSelected" in the code below).
When executing the code i always get "Run-time error '3022': The changes you requested to the table were not successful because they would create duplicate values in the index, primary key, or relationship. So it goes wrong at the creation of the Autonumber in the field "ID" (= the only field that is indexed - no duplicates).
When debugging, line "TopicRecord.Update" in the code below is highlighted.
I have read several posts on this topic on this forum and on other forums but still cannot get this to work - i must be overlooking something....
Private Sub Copy_Click()
Dim JournalEntrySourceRecord, JournalEntryDestinationRecord, TopicRecord As Recordset
Dim JournalEntryToCopyFromCtl, JournalEntryToCopyToCtl, JournalEntryDateCreatedCtl, SelectedTopicsCtl As Control
Dim Counter, intI As Integer
Dim SelectedTopic, varItm As Variant
Set JournalEntryToCopyFromCtl = Forms![Copy Journal Entry]!JournalEntryToCopyFrom
Set JournalEntryToCopyToCtl = Forms![Copy Journal Entry]!JournalEntryToCopyTo
Set JournalEntryDateCreatedCtl = Forms![Copy Journal Entry]!JournalEntryDateCreated
Set JournalEntrySourceRecord = CurrentDb.OpenRecordset("Select * from JournalEntries where ID=" & JournalEntryToCopyFromCtl.Value)
Set JournalEntryDestinationRecord = CurrentDb.OpenRecordset("Select * from JournalEntries where ID=" & JournalEntryToCopyToCtl.Value)
Set SelectedTopicsCtl = Forms![Copy Journal Entry]!TopicsToCopy
Set TopicRecord = CurrentDb.OpenRecordset("Topics", dbOpenDynaset, dbSeeChanges)
With JournalEntryDestinationRecord
.Edit
.Fields("InitiativeID") = JournalEntrySourceRecord.Fields("InitiativeID")
.Fields("DateCreated") = JournalEntryDateCreatedCtl.Value
.Fields("Comment") = JournalEntrySourceRecord.Fields("Comment")
.Fields("Active") = "True"
.Fields("InternalOnly") = JournalEntrySourceRecord.Fields("InternalOnly")
.Fields("Confidential") = JournalEntrySourceRecord.Fields("Confidential")
.Update
.Close
End With
JournalEntrySourceRecord.Close
Set JournalEntrySourceRecord = Nothing
Set JournalEntryDestinationRecord = Nothing
For Each SelectedTopic In SelectedTopicsCtl.ItemsSelected
TopicRecord.AddNew
For Counter = 3 To SelectedTopicsCtl.ColumnCount - 1
TopicRecord.Fields(Counter) = SelectedTopicsCtl.Column(Counter, SelectedTopic)
Next Counter
TopicRecord.Fields("JournalEntryID") = JournalEntryToCopyToCtl.Value
TopicRecord.Fields("DateCreated") = JournalEntryDateCreatedCtl.Value
TopicRecord.Update
Next SelectedTopic
TopicRecord.Close
Set TopicRecord = Nothing
End Sub
First, your Dims won't work as you expect. Use:
Dim JournalEntrySourceRecord As Recordset
Dim JournalEntryDestinationRecord As Recordset
Dim TopicRecord As Recordset
Second, it looks like you get your ID included here:
TopicRecord.Fields(Counter)
or Topic is a query that includes it somehow. Try to specify the fields specifically and/or debug like this:
For Counter = 3 To SelectedTopicsCtl.ColumnCount - 1
TopicRecord.Fields(Counter).Value = SelectedTopicsCtl.Column(Counter, SelectedTopic)
Debug.Print Counter, TopicRecord.Fields(Counter).Name
Next Counter

Multiple query Records Vbscript

Pulling multiple records onto one label is not supported in the currently released version of BarTender. So I heard that a VBScript can help me to achieve this. I never touch this before, so sorry for my lack of comprehension
I am trying to create a VBScript that connect to my database and execute the following query :
select Quantite, description_device
from utilise, medical_devices
where utilise.id_operation = 25
and utilise.id_dispositif = medical_devices.id_device
I created this :
Dim cn, rs
set cn = CreateObject("ADODB.Connection")
set rs = CreateObject("ADODB.Recordset")
cn.connectionString = "Driver={MySQL ODBC 5.3 Driver};Server=myip;Database=mydb;User=myuser; Password=mypassword;"
cn.open
rs.open "select ...", cn, 3
rs.MoveFirst
while not rs.eof
wscript.echo rs(0)
rs.next
wend
cn.close
But even the first line fail with this error : <Line 1: Value = Dim cn, rs: Syntax error>
How to proceed to get this script running?
Are you using Bartender Software to create the VBScript?
You have to choose Multi-Line Script under Script Type

Valid response causes "Subcript out of range"

I've got a classic ASP application that contacts a database and receives a valid response but then crashes with
Error Number 9: Subscript out of range
after exiting the IF block the db call is made in. What's odd is that the same code is currently working in production. As far as I can tell they're configured identically (but I suspect there's a subtle difference that's causing this issue) and have identical code bases.
What I want to know is:
Where is this array that I'm supposedly attempting to reach a non-existent index of? I don't see it and the error gives no line number. Is there a chance something is not working correctly in the adodb library?
Perhaps this is a common problem having to do with a certain patch and my particular db connection library? Have you had a similar experience?
How do I troubleshoot a problem that doesn't immediately present itself? Should I just start putting troubleshooting statements in the library?
Explanation of what's happening in the code: When the cookie "click" is received err.number is 0. When the cookie "bang" is received the err.number is 9. It then crashes with that error at the end of the IF block.
<%#Language="VBSCRIPT"%>
<% Server.ScriptTimeout = 150 %>
<%
On Error resume Next
%>
<!--#include file="adovbs.inc"-->
<!--#INCLUDE FILE="DBConn.asp"-->
<!--#INCLUDE FILE="ErrorHandler.asp"-->
<%
'Application Timeout Warning
sessionTimeout = 20
advanceWarning = 5
jsTimeout = (sessionTimeout - advanceWarning) * 60000
'If the users session has expired
If Session("USERNAME") = "" or Session("USERNAME") = NULL Then
Response.Redirect("default.asp")
End If
'If the user has just changed their password. Prompt them that it was successfully changed
If Request("changePasswd") = "true" Then
Response.Write("<script language='Javascript'>alert('Your Password Has been Successfully Changed!');</script>")
End If
Dim connection, cmd, objRS, latestDate, lastDateJPMC, firstDateJPMC, lastDateWACH, firstDateWACH, lastDateWFB, firstDateWFB, accountCount
Function calConvertDate(theDate)
Dim yr, mn, dy, dtSplit
dtSplit = Split(theDate,"/")
yr = dtSplit(2)
mn = dtSplit(0)
dy = dtSplit(1)
if Len(mn) = 1 then mn = "0" & mn
if Len(dy) = 1 then dy = "0" & dy
calConvertDate = "[" & yr & "," & mn & "]"
End Function
set connection = Server.CreateObject("adodb.connection")
connection.Open DBConn
connection.CommandTimeout = 60
set connection = Server.CreateObject("adodb.connection")
connection.Open DBConn
connection.CommandTimeout = 60
'Get Earliest & Latest Date in Database
If Err.Number = 0 Then
Response.Cookies("CLICK")=Err.number
Set cmd = Server.CreateObject("ADODB.Command")
With cmd
Set .ActiveConnection = connection
.CommandText = "CIRS_Admin.spGetLatestDate"
.CommandType = adCmdStoredProc
set objRS = .Execute
End With
latestDate = calConvertDate(objRS("latestDate"))
Response.Cookies("latestdate")=objRS("latestDate")
objRS.Close
Set objRS = Nothing
Response.Cookies("BANG")=Err.number
End If
To debug, please add a statement like
Response.Write (objRS("latestDate"))
before the line
latestDate = calConvertDate(objRS("latestDate"))
so you can see if (for example) the date returned from the server has "-" as separator instead of "/" or if an empty value is returned.
After understanding what is causing the problem you can solve it
1.Where is this array that I'm supposedly attempting to reach a non-existent index of? I don't see it and the error gives no line number. Is there a chance something is not working correctly in the adodb library?
This is your array:
yr = dtSplit(2)
mn = dtSplit(0)
dy = dtSplit(1)
What's odd is that the same code is currently working in production. As far as I can tell they're configured identically (but I suspect there's a subtle difference that's causing this issue) and have identical code bases.
May be you have different regional settings?
I strongly suggest to you use better error handling.
Internal Server Error 500 w/ IIS Log

Reduced performance when creating object in classic asp

Trying to measure a website performance I created a simple logging sub to see what parts are slow during the execution of a classic asp page.
sub log(logText)
dim fs, f
set fs = Server.CreateObject("Scripting.FileSystemObject")
set f = fs.OpenTextFile("log.txt", 8, true)
f.WriteLine(now() & " - " & logText)
f.Close
set f = Nothing
set fs = Nothing
end sub
log "Loading client countries"
set myR = Server.CreateObject("ADODB.RecordSet")
myR.ActiveConnection = aConnection
myR.CursorLocation=2
myR.CursorType=3
myR.LockType=2
myR.Source = "SELECT * FROM CC ORDER BY ccName ASC"
log "Opening db connection"
myR.open()
log "Opened db connection"
Here are the results (only showing the time part):
...
11:13:01 - Loading client countries
11:13:06 - Opening db connection
11:13:06 - Opened db connection
...
Creating the ADODBRecordSet and setting a few properties takes about 5 seconds. This does not always happen, sometimes the code is executed fast, but usually when I reload the page
after a few minutes the loading times are more or less the same as the example's. Could this really be a server/resources issue or should I consider rewriting the code? (My best option would be to write this in C#, but I have to study this code first before moving forward anyway).
Update: I added more code after receiving 1st comment to present a few more code. Explanation: The code creates a combobox (selection menu) with the retrieved countries (it continues where the previous piece of code stopped).
if not myR.eof then
clientCountries = myR.getrows
send("<option value='0'>Select country</option>")
log "Creating combobox options"
for i = 0 to ubound(clientCountries, 2)
if cstr(session("clientCountry")) <> "" then
if cstr(clientCountries(1, i)) = cstr(session("clientCountry")) then
isSelected = "selected" else isSelected = ""
end if
end if
if cstr(session("clientCountry")) = "" then
if cstr(clientCountries(1, i)) = "23" then
isSelected = "selected"
else
isSelected = ""
end if
end if
optionString = ""
optionString = clientCountries(2, i)
send("<option value='" & clientCountries(1, i) & "' " & isSelected & ">" & convertToProperCase(optionString) & "</option>")
next
log "Created combobox options"
end if
myR.Close
myR.ActiveConnection.close
myR.ActiveConnection = nothing
set myR = nothing
log "Loaded client countries"
The next two log entries are as follows:
11:13:06 - Creating combobox options
11:13:06 - Created combobox options
...
So far, the SELECT query as the rest of the page (2 or 3 queries more) is executed within the next second more or less. The only part slowing the page down is what you can see in the first part of the log. I'm not sure if I can profile the SQLServer, because I only have cPanel access. This is the only way I know of, unless there's something else I could have a look at.
First, Check your connection string, I've experienced slower times with certain providers. The best provider I've found for classic asp is sqloledb
Second, I would close my SQL object before I did the For statement on the GetRows() array. You don't want to keep that open if you don't need to.
Third, I'd use stored procedures. You'll get a performance improvement by saving on compile time.
Fourth, I would avoid doing a SELECT * statement at all cost, instead I would return ONLY the columns I need. (Your code looks like it only needs 2 columns)
Fifth, I would build indexes on the tables taking longer than expected.
If this doesn't resolve the issue, I would consider other languages/solutions. Not sure what the dataset looks like, so can't say if a flat-file database should be considered or not.
Also, try this for a recordset instead and see what happens:
Set myR = Server.CreateObject("Adodb.Recordset")
myR.Open "SELECT * FROM CC ORDER BY ccName ASC", aConnection
If myR.RecordCount > 0 Then clientCountries = myR.GetRows()
myR.Close
Set myR = Nothing
If IsArray(myR) Then
For ....

Copy one Recordset to another

Since I received so nice and fast solution to my problem, I will try again to get some help from you:
I opened two Recordsets.
Set cmd1.ActiveConnection = cn1
cmd1.CommandText = "SELECT * FROM mov Where [Date] >= #" & DateA & "#;"
Set RSold = cmd1.Execute
Set cmd2.ActiveConnection = cn2
cmd2.CommandText = "SELECT * FROM mov"
Set RSnew = cmd2.Execute
(I want to save only selected records of a file.)
I know how to copy record by record, but is there a 'Short Cut' to do it faster ?
Thanks
try this:
Dim i As Long
Do While Not RSold.EOF
' You can place if condition here
RSNew.AddNew
For i = 0 To RSold.Fields.Count - 1
RSNew.Fields(RSold.Fields(i).Name) = RSold.Fields(i).Value
Next i
RSNew.Update
RSold.MoveNext
Loop
This will copy records from RSold to RSnew recordset
You Can use code :
Set RSNew = RSOld.Clone
#user1838163 :Saving the second Recordset as a file
Dim RFileNm As String
Dim fs
Set fs = CreateObject("Scripting.FileSystemObject")
RFileNm = "c:\temp\" & Trim(RFileNm) & ".adt"
fs.DeleteFile (RFileNm)
RSNew .Save RFileNm, adPersistADTG
RSNew .Close
RSNew .Open RFileNm, , , , adCmdFile
I think this will do what you want by doing it all at once.
Dim objPB As New PropertyBag
objPB.WriteProperty "rs", RSOld
Set RSNew = objPB.ReadProperty("rs")
Set objPB = Nothing
I don't think CLONE is going to do what you want. It just gives you another view of the same recordset you already have. This allows you to use multiple bookmarks and so forth, but the recordset is still attached to the same database the original was. I also need a way to copy the recordset and save it to a new database in a new format.

Resources