Microsoft VBScript runtime error '800a0009' - asp-classic

Question

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!

Answer 1

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.

Answer 2

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.

Answer 3

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.