I have a classic asp webpage written in vbscript that outputs the results from a third-party stored procedure. My user wants the page to display the columns of data in a different order than they come in from the database. Is there an easy and safe way to re-order the columns in an ADO recordset?
I did not write this page and cannot change the SP.
What is the minimum change I can make here to get the job done and not risk screwing up all the other stuff in the page?
The code looks something like
dim Conn, strSQL, RS
Set Conn = Server.CreateObject("ADODB.Connection")
Conn.Open ServerName
Set strSQL = "EXEC storedProc #foo = " & Request("fooParam")
'This stored procedure returns a date column, an arbitrary '
' number of data columns, and two summation columns. We '
' want the two summation columns to move so they appear '
' immediately after the data column '
Set RS = Server.CreateObject("ADODB.RecordSet")
RS.ActiveConnection = Nothing
RS.CursorLocation = adUseClient
RS.CursorType = adOpenStatic
RS.LockType = adLockBatchOptimistic
RS.Open strSQL, Conn, adOpenDynamic, adLockOptimistic
dim A
' ----- '
' Insert some code here to move the columns of the RS around '
' to suit the whim of my user '
' ----- '
' Several blocks of code that iterate over the RS and display it various ways '
RS.MoveFirst
For A = 0 To RS.Fields.Count -1
' do stuff '
Next
...
RS.MoveFirst
For A = 0 To RS.Fields.Count -1
' do more stuff '
Next
RS.Close : Set RS = Nothing
Conn.Close : Set Conn = Nothing
Get the column names, then set up an ordering for them:
dim ColumnNames
set ColumnNames = CreateObject( "Scripting.Dictionary" )
For A = 0 To RS.Fields.Count -1
ColumnNames.Add A, RS.Fields(A).Name
Next
Here, ColumnNames holds the name of the column to use for each position. Applying whatever rules make sense, you can now change the ordering like so:
'' swap order of columns 1 and 2
dim temp
temp = ColumnNames.item( 1 )
ColumnNames.item( 1 ) = ColumnNames.item( 2 )
ColumnNames.item( 2 ) = temp
Finally, to get the new order, print as follows:
For A = 0 To RS.Fields.Count -1
Response.write( ColumnNames.item( A ) )
Next
Why do you need to reorder them? If you KNOW that the output follows a certain pattern:
Date, Data1, DataN, Sum1, Sum2
You have Fields.Count to let you decide how many DataN columns to display, and at which index Sum1 and Sum are located.
Related
My database has:
Table name “Books”
Query name “BooksQMiss”
Form name “100” which has a combo name “Combo0”
The query has the following fields:
Field name "Serial"
Field name “Section”
I use the below module to find the gaps in field "Serial" with a criteria inserted in “Section” field:
[Forms]![100]![Combo0]
Query name “BooksQMiss”
Function FindGaps()
Dim mydb As Database
Dim mytbl As Recordset
Dim mytbl2 As Recordset
Dim lastnum As Integer
DoCmd.SetWarnings False
DoCmd.RunSQL "DELETE Lost_Number.* FROM Lost_Number;"
DoCmd.SetWarnings True
Set mydb = DBEngine.Workspaces(0).Databases(0)
Set mytbl = mydb.OpenRecordset("BooksQMiss") ' The problem is here
Set mytbl2 = mydb.OpenRecordset("Lost_number")
With mytbl
.MoveFirst
lastnum = 1
Do Until .EOF
If !Serial - lastnum >= 1 Then
Do
If mytbl!Serial - lastnum = 0 Then Exit Do
With mytbl2
.AddNew
!missing = lastnum
.Update
End With
lastnum = lastnum + 1
Loop
lastnum = lastnum + 1
.MoveNext
Else
lastnum = !Serial + 1
.MoveNext
End If
Loop
End With
mytbl.Close
mytbl2.Close
Set mytbl = Nothing
Set mytbl2 = Nothing
Set mydb = Nothing
DoCmd.OpenForm "frm-Lost_Number", acNormal, "", "", , acNormal
End Function
My question is why I got this massage "too few parameters. expected 1"?
Anyone can help!
Thank you.
Been trying to style my gridview for some time. It gets data dynamical and would then able to put margin (padding) on one of the columns.
Is this even possibly to do?
Because when I try to get the columns count it allways return 0.
Is there some other way to make this?
Also would like to cellSpace but only Horizontal not vertical any suggestions there?
gwResult.DataSource = dvData
gwResult.DataBind()
gwResult.GridLines = GridLines.None
'Dim desc As Integer
'gwResult.RowStyle.HorizontalAlign = HorizontalAlign.Left
'headCell = gwResult.HeaderRow.Cells.Count
'rows = gwResult.Rows.Count
'For i As Integer = 0 To headCell - 1
' gwResult.HeaderRow.Cells(i).HorizontalAlign = HorizontalAlign.Left
' headerText = gwResult.HeaderRow.Cells(i).Text
' If headerText = "Description" Then
' desc = i
' 'Else
' ' gwResult.HeaderRow.Cells(i).Width = 75
' End If
' Next
'For Each row As GridViewRow In Me.gwResult.Rows
' 'row.Cells(desc).CssClass = "gwStyle"
' For i As Integer = 0 To headCell - 1
' If IsNumeric(row.Cells(i).Text) Then
' row.Cells(i).HorizontalAlign = HorizontalAlign.Right
' End If
' Next
'Next
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.
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
Here's my code
Dim RefsUpdate As String() = Session("Refs").Split("-"C)
Dim PaymentsPassedUpdate As String() = Session("PaymentsPassed").Split("-"C)
Dim x as Integer
For x = 1 to RefsUpdate.Length - 1
Dim LogData2 As sterm.markdata = New sterm.markdata()
Dim queryUpdatePaymentFlags as String = ("UPDATE OPENQUERY (db,'SELECT * FROM table WHERE ref = ''"+ RefsUpdate(x) +"'' AND bookno = ''"+ Session("number") +"'' ') SET alpaid = '"+PaymentsPassedUpdate(x) +"', paidfl = 'Y', amountdue = '0' ")
Dim drSetUpdatePaymentFlags As DataSet = Data.Blah(queryUpdatePaymentFlags)
Next
I don't get any errors for this but it doesn't seem to working as it should
I'm passing a bookingref like this AA123456 - BB123456 - CC123456 - etc and payment like this 50000 - 10000 - 30000 -
I basically need to update the db with the ref AA123456 so the alpaid field has 50000 in it.
Can't seem to get it to work
Any ideas?
Thanks
Jamie
I'm not sure what isn't working, but I can tell you that you are not going to process the last entry in your arrays. You are going from 1 to Length - 1, which is one short of the last index. Therefore, unless your input strings end with "-", you will miss the last one.
Your indexing problem mentioned by Mark is only one item, but it will cause an issue. I'd say looking at the base your problem stems from not having trimmed the strings. Your data base probably doesn't have spaces leading or trailing your data so you'll need to do something like:
Dim refsUpdateString as string = RefsUpdate(x).Trim()
Dim paymentsPassedUpdateString as string = PaymentsPassedUpdate(x).Trim()
...
Dim queryUpdatePaymentFlags as String = ("UPDATE OPENQUERY (db,'SELECT * FROM table WHERE ref = ''" & refsUpdateString & "'' AND bookno = ''" & Session("number") & "'' ') SET alpaid = '" & paymentsPassedUpdateString & "', paidfl = 'Y', amountdue = '0' ")
Also, I would recommend keeping with the VB way of concatenation and use the & character to do it.