Issue with migration using classic ASP - asp-classic

Having a problem with migration of a site from one server to another, here is the error I'm getting:
Microsoft Cursor Engine error '80040e21'
Multiple-step operation generated errors. Check each status value.
/common/classes/Cart.asp, line 110
Line 110 is:
fld.Value = Request(fld.Name)
Here is the code that's causing the issue:
public function InsertOrder
set rs = Server.CreateObject("ADODB.Recordset")
rs.ActiveConnection = OrdersConnectionString
rs.Source = "SELECT * FROM "& OrdersTable
rs.CursorType = 3
rs.CursorLocation = 3
rs.LockType = 3
rs.Open()
rs.AddNew
For Each fld in rs.Fields
if Len(Request(fld.Name)) > 0 then
fld.Value = Request(fld.Name)
end if
Next
rs.Update
rs.Requery
rs.Sort=OrderKey &" desc "
OrderID=rs(OrderKey)
end function
It used to use SQL2008 but the new server us running SQL2016.
Thanks for any ideas you can give.

Judging from the code causing this error, this is most likely a problem with type casting behind the scenes. Somehow the database driver fails to properly convert the data to the proper type, so you have to do that yourself.
One way which is pretty flexible, is defining key/value pairs (VBScript Dictionary can fit in this case) where the key will be the field name, and the value will be the type to which to convert the value. (String, Integer, Double, Date)
Sample code would be: (untested, but should work as-is, provided you put correct details)
Const FIELD_TYPE_STRING = 1
Const FIELD_TYPE_INTEGER = 2
Const FIELD_TYPE_DOUBLE = 3
Const FIELD_TYPE_DATE = 4
Const FIELD_TYPE_CURRENCY = 5
Function ConverFieldValue(rawValue, fieldType)
ConverFieldValue = VBNull
Select Case fieldType
Case FIELD_TYPE_STRING:
ConverFieldValue = CStr(rawValue)
Case FIELD_TYPE_INTEGER:
If rawValue<>"" Then ConverFieldValue = CLng(rawValue)
Case FIELD_TYPE_DOUBLE
If rawValue<>"" Then ConverFieldValue = CDbl(rawValue):
Case FIELD_TYPE_DATE:
If rawValue<>"" Then ConverFieldValue = CDate(rawValue)
Case FIELD_TYPE_CURRENCY:
If rawValue<>"" Then ConverFieldValue = CCur(rawValue)
End Select
End Function
Dim typeMapping
Set typeMapping = Server.CreateObject("Scripting.Dictionary")
'''***Add actual field names and types below:****
typeMapping.Add "Field1", FIELD_TYPE_STRING
typeMapping.Add "Field2", FIELD_TYPE_INTEGER
typeMapping.Add "Field3", FIELD_TYPE_DOUBLE
typeMapping.Add "Field4", FIELD_TYPE_CURRENCY
typeMapping.Add "Field5", FIELD_TYPE_DATE
'''*************************************************
Dim currentFieldType, currentFieldValue
Set rs = Server.CreateObject("ADODB.Recordset")
rs.ActiveConnection = OrdersConnectionString
rs.Source = "SELECT * FROM "& OrdersTable
rs.CursorType = 3
rs.CursorLocation = 3
rs.LockType = 3
rs.Open()
rs.AddNew
For Each fld in rs.Fields
if Len(Request(fld.Name)) > 0 then
currentFieldType = typeMapping(fld.Name)
currentFieldValue = ConverFieldValue(Request(fld.Name), currentFieldType)
fld.Value = currentFieldValue
end if
Next
rs.Update
rs.Requery
rs.Sort=OrderKey &" desc "
OrderID=rs(OrderKey)

Related

SQL Server procedure has too many arguments specified

I get the error
Procedure or function has to many arguments specified
but only sometimes. It's a REST API and cellphones call this function to validate the user. Today it's onli 1-2 cellphones and they make the call every second minute.
It works well most times but sometimes I get this error code.
To see what's wrong, I've made a small loop that gathers the parameters into a string. And sometimes they are two #GUID and #Datum and sometimes repeat themselves.
Here is the VB code:
Public Shared Sub validatePhone(secretKey As String, ByRef _RS As phoneData, Fnr As Integer)
Dim connStr As String = System.Configuration.ConfigurationManager.AppSettings("ConnStringSQL")
Dim Conn As SqlConnection = New System.Data.SqlClient.SqlConnection(connStr)
Dim _theString As New System.Text.StringBuilder
Try
_RS.message = ""
_RS.status = True
Dim Status As Integer = 0
Dim _GUID As Guid = New Guid(secretKey)
Try
Conn.Open()
Catch ex As Exception
End Try
cmd.Connection = Conn
Apt.SelectCommand = cmd
cmd.CommandType = CommandType.StoredProcedure
cmd.CommandText = "API2017_checkPhone"
cmd.Parameters.Clear()
cmd.Parameters.Add("#GUID", SqlDbType.UniqueIdentifier).Value = _GUID
cmd.Parameters.Add("#Datum", SqlDbType.SmallDateTime).Value = Now
For Each item As SqlParameter In cmd.Parameters
_theString.Append(item.ParameterName & ";")
Next
Apt.Fill(ds, "DataCheckPhone")
If ds.Tables("DataCheckPhone").Rows.Count > 0 Then
With ds.Tables("DataCheckPhone").Rows(0)
Status = .Item("spStatus")
If Status = 0 Then
_RS.Namn = .Item("Namn")
_RS.SalesID = .Item("SalesID")
_RS.Anlaggning = .Item("Anlaggning")
_RS.Anlnr = .Item("Anlnr")
Funktions.URLEncodeStr(_RS.Namn)
Funktions.URLEncodeStr(_RS.Anlaggning)
End If
End With
Else
Dim _Lnum As Integer
Funktions.Logg(Fnr & ": " & "Fatal error", 999, _Lnum, 0)
_RS.message = "Error 999:" & _Lnum.ToString
Return
End If
Catch ex As Exception
_RS.status = False
_RS.Anlaggning = Nothing
_RS.Anlnr = 0
_RS.Namn = Nothing
_RS.SalesID = Nothing
Dim _Lnum As Integer
Funktions.Logg(Fnr & ": " & ex.Message & "{" & _theString.ToString & "}", 999, _Lnum, 0)
_RS.message = "Error 999:" & _Lnum.ToString
Finally
ds.Tables.Clear()
Try
ds.Tables("DataCheckPhone").Dispose()
Catch ex As Exception
End Try
End Try
Try
Conn.Close()
Conn.Dispose()
Catch ex As Exception
End Try
End Sub
And here is the stored procedure:
ALTER PROCEDURE [dbo].[API2017_checkPhone]
#GUID as uniqueidentifier,
#Datum as smalldatetime
AS
DECLARE #Status AS INT
DECLARE #Anlaggning AS NVARCHAR(50)
DECLARE #Namn AS NVARCHAR(50)
DECLARE #Anlnr AS INT
DECLARE #SalesID AS uniqueidentifier
DECLARE #LockedSalesman AS BIT
DECLARE #LockedAnlaggning AS BIT
SET #Status = 0
IF EXISTS (SELECT * FROM KK2017_connectedPhones WHERE [guid] = #guid)
BEGIN
SET #status = 0
SET #salesID = (SELECT salesID FROM KK2017_connectedPhones
WHERE [guid] = #guid)
SET #Anlnr = (SELECT anlnr FROM KK2017_Säljare WHERE salesID = #salesID)
SET #Namn = (SELECT Namn FROM KK2017_Säljare WHERE salesID = #salesID)
SET #Anlaggning = (SELECT namn FROM KK2017_Anlaggning WHERE anlnr = #Anlnr)
SET #LockedSalesman = (SELECT locked FROM KK2017_Säljare WHERE salesID = #salesID)
UPDATE KK2017_Säljare
SET inloggad = #Datum
WHERE salesID = #SalesID
IF #LockedSalesman = 1
BEGIN
SET #Status = 2
END
SET #LockedAnlaggning = (SELECT locked FROM KK2017_Anlaggning
WHERE AnlNr = #Anlnr)
IF #LockedAnlaggning = 1
BEGIN
SET #status = 3
END
END
ELSE
SET #status = 1
SELECT
#Status AS spStatus,
#Anlaggning AS Anlaggning,
#anlnr AS anlnr,
#Namn AS namn,
#SalesID AS salesID
I must have done something wrong but can not see it.
If anyone has a proposal, I would be grateful.
/Claes
You have a threading issue because you have defined cmd as shared, which means there is only one instance servicing all of the incoming requests. Sometimes two threads are in the process of adding parameters at the same time, and both threads end up with four, hence the error.
The standard pattern here would be declare cmd as a local variable, and instantiate a new instance each time the function is called. The overhead to this is negligible.
Also, avoid shared variables in multithreaded applications (such as web services). There is only one copy of the variable for all users and all threads, and 99% of the time that is not what you actually want. For the other 1% usually you'd use application variables or HttpCache. In this case you should use a local variable.

ifnull not enough for testing for numerical rs

I have a function, which is supposed to return zero, if the input cannot be converted to an integer.
But sometimes it fails, if the field from a resultset is not a proper value, whatever it is.
Function nulblank(str)
dim val
if IsNull(str) then
val=0
else
str = trim(str)
if isNumeric(str) then
val = cDbl(str)
else
val = 0
end if
end if
nulblank = val
end function
I get an error 0x80020009 on str = trim(str)
This function is only called on
set rs = conn.execute(sql)
i = nulblank(rs("somefield"))
How can I make this function "failsafe", so it never dies, but returns 0 on "bad" values?
I guess I could do on error resume next and if Err.Number <> 0 then something.
But what can be in a rs("somefield") which is not null, but cannot be trim()'ed?
That error usually relates to an empty recordset.
You should check that the recordset has a row before attempting to retrieve a column value, eg:
set rs = conn.execute(sql)
if not rs.eof then
i = nulblank(rs("somefield"))
end if

Multiple "If Then Else" in "Do While Not" loop not working, but they do singularly

OK so here is what's pulling my hair out ! I have a page which reads records from a table in one DB, manipulates the data slightly, then writes it to another DB.
In the Do While Not EOF loop, I have a number of If Then Else statements to manipulate the data.
If I run the code in full, most of the If Then Else do not work, if I run the page with just each one in there, they work fine.
I have spent 8 hrs+ working on this and am still baffled
Dim rsndb, fieldstr1, fieldstr2, fieldstr3, fieldstr4, fieldstr5, fieldstr6, fieldstr7, fieldstr8, fieldstr9, fieldstr10, fieldstr11, fieldstr12, fieldstr13, fieldstr14, fieldstr15
recordstr = 0
'##### Empty temp table #####
Set Connection = Server.CreateObject("ADODB.Connection")
Connection.Open "DSN=website"
cSql = "DELETE FROM newtandltest"
Connection.Execute (cSql)
Connection.Close
Set Connection = Nothing
' Select Records From House Database
Set adoCon = Server.CreateObject("ADODB.Connection")
adoCon.Open "DSN=newdatabase;UID=Intranet;Pwd=password;"
Set rsndb = Server.CreateObject("ADODB.Recordset")
strSQL="Select top 500 VendorTransaction.VendorNo As propvendor, Resort.ResortCode As rid, Resort.ResortName As resname, Locations.LocationName As proploc, Country.CountryCode As propcountry, Season.SeasonDesc As propsea, Property.SeasonDesc As propextrasea, Property.Size As psize, Property.Occupancy As occ, FloatingPoints.FloatingPointsName As TAOLF, Property.StartWeek As propsw, Property.EndWeek As propew, Property.Weeks As propweeks, Property.Points As proppoints, Property.WebPricePW As webprice, Property.Priority As priority, Property.OpenToOffer As offers, Property.PoAOffer As poa, Property.RentalPW As rentalpw, Property.WebDate As webdate"
strSQL = strSQL & " From Property Inner Join Resort On Property.ResortId = Resort.Id Inner Join Country On Resort.CountryId = Country.Id Inner Join Locations On Resort.LocationId = Locations.Id Inner Join FloatingPoints On Property.FloatPointId = FloatingPoints.Id Inner Join PropertyStatus On Property.StatusId = PropertyStatus.Id Inner Join PropertyType On Property.TypeId = PropertyType.Id Inner Join Season On Property.SeasonId = Season.Id Inner Join VendorTransaction On VendorTransaction.propertyId = Property.Id Where (Property.WebDate >= DateAdd(day, -187, GetDate()) And Property.StatusId = 4 and year(Property.WebDate) <> 9999)"
rsndb.Open strSQL, adoCon
Set adoCon1 = Server.CreateObject("ADODB.Connection")
adoCon1.Open "DSN=website"
Do While not rsndb.EOF
'------------------------------------------------------------------------------------------------------------------
fieldstr1 = rsndb("webdate")
'------------------------------------------------------------------------------------------------------------------
fieldstr2 = rsndb("propvendor")
'------------------------------------------------------------------------------------------------------------------
fieldstr3 = rsndb("propcountry")
If rsndb("proploc") = "FLOR" Then
fieldstr3 = rsndb("proploc")
End If
If rsndb("proploc") = "MADE" Then
fieldstr3 = rsndb("proploc")
End If
If rsndb("propcountry") = "ESC" Then
fieldstr3 = rsndb("propcountry") & left(rsndb("proploc"),1)
End If
'------------------------------------------------------------------------------------------------------------------
resnamestr = replace(rsndb("resname"),chr(13)," ")
resnamestr = replace(rsndb("resname"),chr(34),"")
resnamestr = replace(rsndb("resname"),"'","")
fieldstr4 = resnamestr
'------------------------------------------------------------------------------------------------------------------
fieldstr5 = rsndb("propsea")
If len(rsndb("propextrasea")) > 3 Then
fieldstr5 = rsndb("propextrasea")
End If
If rsndb("propcountry") = "POIN" Then
fieldstr5 = ""
End If
'------------------------------------------------------------------------------------------------------------------
fieldstr6 = ""
'------------------------------------------------------------------------------------------------------------------
fieldstr7 = rsndb("propweeks")
If rsndb("propcountry") = "POIN" Then
fieldstr7 = rsndb("proppoints")
End If
'------------------------------------------------------------------------------------------------------------------
If rsndb("propsw") = rsndb("propew") Then
fieldstr8 = rsndb("propsw")
End If
If rsndb("propcountry") = "POIN" Then
fieldstr8 = "POINTS"
fieldstr9 = "n/a"
End If
If rsndb("propsw") < rsndb("propew") Then
fieldstr8 = rsndb("propsw") & "/" & rsndb("propew")
End If
If rsndb("TAOLF") = "F" Then
fieldstr8 = "FLOATING"
End If
'------------------------------------------------------------------------------------------------------------------
tempsize = rsndb("psize")
Select Case tempsize
Case 1
fieldstr9 = "Studio" & " - " & rsndb("occ")
Case 2
fieldstr9 = "1 Bedroom" & " - " & rsndb("occ")
Case 3
fieldstr9 = "2 Bedroom" & " - " & rsndb("occ")
Case 4
fieldstr9 = "3 Bedroom" & " - " & rsndb("occ")
Case 5
fieldstr9 = "4 Bedroom" & " - " & rsndb("occ")
End Select
'------------------------------------------------------------------------------------------------------------------
fieldstr10 = rsndb("rid")
'------------------------------------------------------------------------------------------------------------------
fieldstr11 = rsndb("rid")
'------------------------------------------------------------------------------------------------------------------
fieldstr12 = ""
'------------------------------------------------------------------------------------------------------------------
fieldstr13 = "N"
'------------------------------------------------------------------------------------------------------------------
fieldstr14 = rsndb("webprice")
If rsndb("offers") = 1 Then
fieldstr14 = "Offers"
End If
If rsndb("poa") = 1 Then
fieldstr14 = "POA"
End If
'------------------------------------------------------------------------------------------------------------------
fieldstr15 = rsndb("rentalpw")
lCount = lCount + 1
Set Connection1 = Server.CreateObject("ADODB.Connection")
Connection1.Open "DSN=website"
cSql = "INSERT INTO newtandltest(datefield, field1, field2, field3, field4, field5, field6, field7, field8, field9, field10, field11, field12, price, bargainprice)"
cSql = cSql & "VALUES('"&fieldstr1&"','"&fieldstr2&"','"&fieldstr3&"','"&fieldstr4&"','"&fieldstr5&"','"&fieldstr6&"','"&fieldstr7&"','"&fieldstr8&"','"&fieldstr9&"','"&fieldstr10&"','"&fieldstr11&"','"&fieldstr12&"','"&fieldstr13&"','"&fieldstr14&"','"&fieldstr15&"');"
Connection1.Execute (cSql)
Connection1.Close
Set Connection1 = Nothing
rsndb.MoveNext
Loop
rsndb.Close
adoCon.Close
Set rsndb = Nothing
Set adoCon = Nothing
I am with Shadow Wizard. Tidy up your code, only use rsndb once for every key. And use a dictionary to store your fields with reasonable names. As it is now, it is not maintainable: How should someone know what fieldStr12 stands for?
There is one real bug I spotted: You do three times a replace on the original string, so effectively only the last replace will be visible.
Suggestion how to tidy your code:
Do While not rsndb.EOF
Set fld = createObject("Scripting.Dictionary")
fld.Add "webdate", rsndb("webdate")
fld.Add "propvendor", rsndb("propvendor")
fld.Add "propcountry", rsndb("propcountry")
' etc...
Select Case fld("proploc")
Case "FLOR" fld("propcountry") = fld("proploc")
Case "MADE" fld("propcountry") = fld("proploc")
End case
If fld("propcountry") = "ESC" Then
fld("propcountry") = fld("propcountry") & left(fld("proploc"),1)
End If
' This part is not correct, it is only replacing the ' by an empty string
'resnamestr = replace(rsndb("resname"),chr(13)," ")
'resnamestr = replace(rsndb("resname"),chr(34),"")
'resnamestr = replace(rsndb("resname"),"'","")
'fieldstr4 = resnamestr
fld("resname") = replace(fld("resname"), chr(13), " ")
fld("resname") = replace(fld("resname"), chr(34), "")
fld("resname") = replace(fld("resname"), "'", "")
' etc...
Set Connection1 = Server.CreateObject("ADODB.Connection")
Connection1.Open "DSN=website"
cSql = "INSERT INTO newtandltest(datefield, field1, field2, field3, field4, field5, field6, field7, field8, field9, field10, field11, field12, price, bargainprice)"
' the Items property of a dictionary is an array in the same order that you add them to the dictionary
' You could do the same with the Keys property.
cSql = cSql & "VALUES('" & join(fld.Items, "','") & "');"
Connection1.Execute (cSql)
Connection1.Close
Set Connection1 = Nothing
rsndb.MoveNext
Loop
Something u can improve in your code.
1) You have open connection before while loop so you do not need to open it again in While loop it should be remove
Set Connection1 = Server.CreateObject("ADODB.Connection")
Connection1.Open "DSN=website
While loop ...
WEND
Connection1.Close
Set Connection1 = Nothing
2) check Null and blank before replacing with some value.
for e.g
if(fld("resname") <> "" AND NOT ISNULL(fld("resname")))
replace(fld("resname"), chr(13), " ")
end if
- Note track loop with default value like response.write ("hello") and check in which row loop is breaking and by which cause
The only thing that I can see that might cause this is reading the same field more than once; with certain types of fields (e.g. Memo field of Access) it might become blank after the first read.
To fix such problem you need to read each field once, and store it into local variable:
Do While not rsndb.EOF
curPropLoc = rsndb("proploc")
curPropCountry = rsndb("propcountry")
'...
fieldstr3 = curPropCountry
If curPropLoc = "FLOR" Then
fieldstr3 = curPropLoc
End If
If curPropLoc = "MADE" Then
fieldstr3 = curPropLoc
End If
'...keep using curPropLoc instead of rsndb("proploc") throughout the loop...
'...keep using curPropCountry instead of rsndb("propcountry") throughout the loop...
'......
rsndb.MoveNext
Loop

Microsoft VBScript runtime error '800a0009'

I recently inherited a website in ASP, which I am not familiar with. Yesterday, one of the pages began to throw an error:
Microsoft VBScript runtime error '800a0009'
Subscript out of range: 'i'
default.asp, line 19
Here is the code from lines 13-27:
<%
set rs = Server.CreateObject("ADODB.Recordset")
rs.open "SELECT * FROM VENDORS_LIST_TBL WHERE inStr('"& dVendorStr &"','|'&ID&'|')", Cn
DIM dTitle(100), dDescription(100), dLink(100)
i = 0 : Do while NOT rs.EOF : i = i + 1
dTitle(i) = rs.fields.item("dTitle").value
dDescription(i) = rs.fields.item("dDescription").value
dLink(i) = rs.fields.item("dLink").value : if dLink(i) <> "" then dTitle(i) = "" & dTitle(i) & ""
if NOT rs.EOF then rs.movenext
Loop
x = i
rs.Close : Set rs = Nothing
%>
Any ideas on what's going on here and how I can fix it?
Thank you!
You've declared dTitle, dDescription and dLink as Arrays with a size of 100. As you are walking through the recordset, you are assigning elements to those arrays. It would appear that you have more than 100 records in your recordset, so the logic is trying to do something like:
dTitle(101) = rs.fields.item("dTitle").value
This will throw an error because your array isn't big enough to hold all of your data.
The "solution" you chose is not very good. What if within 2 years there will be more than 500? You will forget all about this and waste hours yet again.
Instead of fixed size arrays you can just use dynamic arrays:
DIM dTitle(), dDescription(), dLink()
ReDim dTitle(0)
ReDim dDescription(0)
ReDim dLink(0)
i = 0
Do while NOT rs.EOF
i = i + 1
ReDim Preserve dTitle(i)
ReDim Preserve dDescription(i)
ReDim Preserve dLink(i)
dTitle(i) = rs.fields.item("dTitle").value
dDescription(i) = rs.fields.item("dDescription").value
dLink(i) = rs.fields.item("dLink").value
If (Not(IsNull(dLink(i)))) And (dLink(i) <> "") Then
dTitle(i) = "" & dTitle(i) & ""
End If
rs.movenext
Loop
This will start with one (empty) item in each array - for some reason the code seems to need this - then on each iteration one more item will be added, preserving the others.
Note that I've also fixed small issue that might have caused trouble - in case of NULL value in "dLink" field, you would get blank anchors in your HTML because NULL is not empty string in VBScript.
This how GetRows can be used to achieve the same goal.
<%
Function VendorSearch(sVendor)
Dim cn: Set cn = SomeLibraryFunctionThatOpensAConnection()
Dim cmd: Set cmd = Server.CreateObject("ADODB.Command")
cmd.CommandType = adCmdText
cmd.CommandText = "SELECT dTitle, dDescription, dLink FROM VENDORS_LIST_TBL WHERE inStr(?,'|'&ID&'|')"
cmd.Parameters.Append cmd.CreateParameter("Vendor", adVarChar, adParamInput, Len(sVendor), sVendor)
Set cmd.ActiveConnection = cn
Dim rs : Set rs = cmd.Execute()
VendorSearch = rs.GetRows()
rs.Close()
cn.Close()
End Function
Dim arrVendor : arrVendor = VendorSearch(dVendorStr)
Const cTitle = 0, cDesc = 1, cLink = 2
Dim i
For i = 0 To UBound(arrVendor, 2)
If IsNull(arrVendor(cLink, i) Or arrVendor(cLink, i) = "" Then
arrVendor(cTitle, i) = "" & arr(cTitle, i) & ""
End If
Next
%>
Notes:
The Select statement contains only those fields required in the results, the use of * should be avoided
A parameterised command is used to avoid SQL Injection threat from SQL contactenation.
Constants used for field indices into the resulting 2 dimensional array.
Whilst this code replicates the original munging of the title value this is here as an example only. In reality construction of HTML should be left as late as possible and outputing of all such strings as title and description should be passed through Server.HTMLEncode before sending to the response.

Copy records to another recordset using Active Server Page

I'm programming in Classic ASP. I'm trying to do the paging. My backend is SQL CE 3.5. Unfortunetly, it doesn't support paging in SQL Query (Like row_number() in sql server).
So I go with ASP Paging. But when i ask to the recordset, give me the first 10 records by setting the rs.PageSize and rs.AbsolutePage and all, it gives me all records. So I planned to copy only first 10 rows from the resultant recordset to another new recordset. So I coded like below:
Set rsTemp = CopyRecordsetStructure(objRs)
rsTemp.Open
iRecordsShown = 0
Set objFields = objRs.Fields
intFieldsCount = objFields.Count-1
Do While iRecordsShown < intPageSize And Not objRs.EOF
rsTemp.AddNew
For Idx = 0 To intFieldsCount
rsTemp.Fields(Idx).Value = objRs.Fields(Idx).Value
Next
rsTemp.Update
iRecordsShown = iRecordsShown + 1
objRs.MoveNext
Loop
Public Function CopyRecordsetStructure(ByVal rs)
Dim rsTemp
Set rsTemp = CreateObject("ADODB.Recordset")
Set objFields = rsTemp.Fields
intFieldCount = objFields.Count - 1
For Idx = 0 To intFieldCount
rsTemp.Fields.Append objFields(Idx).Name, _
objFields(Idx).Type, _
objFields(Idx).DefinedSize
Next
Set CopyRecordsetStructure = rsTemp
End Function
The issue is i could not open the" rsTemp". It throws me error
The connection cannot be used to perform this operation. It is either closed or invalid in this context.
If I use some dummy query and connection it doesn't work.
Please help to copy the records from one recordset to another new record set.
Thanks in advance
Ganesh.
Not sure, but this looks wrong
Set objFields = rsTemp.Fields
Shouldn't it be
Set objFields = rs.Fields
With the comments and fixed in the above comments, the function should be updated Set objFields = rs.Fields to:
Usage:
Dim rsTemp
Set rsTemp = CopyRecordset(rsPadicon)
Update Code
Public Function CopyRecordset(rs)
Dim rsTemp, objFields, intFieldsCount, intPageSize
Set rsTemp = CopyRecordsetStructure(rs)
rsTemp.Open
Set objFields = rs.Fields
intFieldsCount = objFields.Count-1
response.write("<li> rs.RecordCount :" & rs.RecordCount & "</li>")
' response.write("<li> intFieldsCount :" & intFieldsCount & "</li>")
rs.MoveFirst
Do While Not rs.EOF
rsTemp.AddNew
Dim i
For i = 0 to intFieldsCount 'use i as a counter
' response.write("<li> Name :" & rs.Fields(i).Name & "</li>")
' response.write("<li> Value :" & rs.Fields(i).Value & "</li>")
if Not IsNull(rs.Fields(i).Value) then
rsTemp.Fields(i).Value = rs.Fields(i).Value
End if
Next
rsTemp.Update
rs.MoveNext
Loop
Set CopyRecordset = rsTemp
End Function
Public Function CopyRecordsetStructure(ByVal rs)
Dim rsTemp, objFields, intFieldCount, Idx
Set rsTemp = CreateObject("ADODB.Recordset")
Set objFields = rs.Fields
intFieldCount = objFields.Count - 1
For Idx = 0 To intFieldCount
rsTemp.Fields.Append objFields(Idx).Name, _
objFields(Idx).Type, _
objFields(Idx).DefinedSize
Next
Set CopyRecordsetStructure = rsTemp
End Function

Resources