Microsoft VBScript runtime error '800a0009'

[Gavin MUNJANJA]

Hi Guys can you please assist im getting Below error Microsoft VBScript runtime error '800a0009'
Microsoft VBScript runtime error '800a0009'

Subscript out of range: '[number: 3]'

/asp_classes/textschema.asp, line 99

Below is my ASP Code

<%
class clsTextSchema
dim objTables

private sub Class_Initializ e
set objTables = new clsTextSchemaTa bles
end sub

public property get Tables
Set Tables = objTables
end property

public function TableExists(tab lename)
dim tblfound
dim i
tblfound = false
for i = 0 to objTables.Count -1
if lcase(objTables .Item(i).Name)= lcase(tablename ) then
tblfound = true
exit for
end if
next

TableExists = tblfound
end function

sub Save(pathname)
dim objFSO
dim schemaStrm
dim i
dim myTable
dim fielddesc
Set objFSO = server.CreateOb ject("Scripting .FilesystemObje ct")

set schemaStrm = objFSO.OpenText File(pathname,2 , true) 'ForWriting

for i = 0 to objTables.Count -1
set myTable = objTables.item( i)
schemaStrm.Writ eLine "[" & myTable.name & "]"
' if myTable.blColNa meHeader=true then
' schemaStrm.Writ eLine "ColNameHeader= True"
' else
schemaStrm.Writ eLine "ColNameHeader= False"
' end if
schemaStrm.Writ eLine "Format=Delimit ed(|)"
schemaStrm.Writ eLine "CharacterSet=A NSI"
for j = 0 to myTable.Fields. Count - 1
fielddesc = myTable.Fields. Item(j).name & " " & myTable.Fields. Item(j).DataTyp e
if myTable.Fields. Item(j).Size <> -1 then
fielddesc = fielddesc & " Width " & myTable.Fields. Item(j).Size
end if
schemaStrm.Writ eLine "Col" & j+1 & "=" & fielddesc
next
next
schemaStrm.clos e

end sub

sub Load(pathname)
dim SchemaStrm
dim objFSO
dim linedata
dim objTable
dim tblCount
dim coldata
dim strFormat

Set objTables = new clsTextSchemaTa bles

set objFSO = server.CreateOb ject("Scripting .FileSystemObje ct")

set SchemaStrm = objfso.OpenText File(pathname,1 ) 'ForReading

tblCount = 0

Do while (not SchemaStrm.AtEn dOfStream)
linedata = trim(SchemaStrm .Readline)
if linedata="" then
elseif (left(linedata, 1) = "[") AND right(lcase(lin edata),5)=".asc]" then
objTables.add mid(linedata,2, len(linedata)-2)
tblCount = tblCount + 1
set CurrentTable = objTables.item( tblCount-1)
elseif left(lcase(line data),instr(1,l inedata,"=")-1) = "colnamehea der" then
currenttable.Co lumnHeaders = (lcase(mid(line data,instr(1,li nedata,"=")-1))="true")
elseif left(lcase(line data),instr(1,l inedata,"=")-1) = "format" then
strFormat = trim(mid(lineda ta,instr(1,line data,"=")-1))
if left(lcase(strf ormat),9) = "delimited" then
strDelimiter = trim(mid(strFor mat,10)) 'Extract the delimiter (including brackets)
strDelimiter = mid(strDelimite r,2,len(strDeli miter)-2) 'Remove the brackets
strFormat = "Delimited"
end if
elseif left(lcase(line data),instr(1,l inedata,"=")-1) = "characters et" then
currenttable.ch arset = mid(linedata,in str(1,linedata, "=")-1)
elseif (left(lcase(lin edata),3)="col" ) AND (isnumeric(mid( linedata,4,inst r(1,linedata,"= ")-4))) then
coldata = split(mid(lined ata,instr(1,lin edata,"=")+1)," ")

if tblCount > 0 then
if ubound(coldata) > 1 then
currenttable.fi elds.add coldata(0), coldata(1), coldata(3)
else
currenttable.fi elds.add coldata(0), coldata(1), -1
end if
end if
end if

if trim(linedata) = "[" & ucase(vRpt) & ".ASC]" then
rpt_found = true
end if
loop
SchemaStrm.clos e
end sub

end class

class clsTextSchemaTa bles
private mCol
private intCount
private objTables()

public sub Class_Initializ e
redim objTables(0)
intCount = 0
end sub

Public property get Count()
Count = intCount
end property

'Add
public sub Add(tablename)
intCount = intCount + 1

if (intCount-1) > ubound(objTable s) then
redim preserve objTables(intCo unt-1)
end if

set objTables(intCo unt-1) = new clsTextSchemaTa ble
objTables(intCo unt-1).name = tablename

end sub

'Remove
public sub Remove(id)
dim i
if (id >= 0) AND (id <= intCount-1) then
if id < intCount-1 then
for i = id to intCount-2
objTables(i) = objTables(i+1)
next
end if

intCount = intCount - 1
redim preserve objTables(intCo unt - 1)
end if
end sub

'Item
public default property get Item(index)
dim i
dim FoundName
if isnumeric(index ) then
set Item = objTables(index )
else
FoundName = False
for i = 0 to intCount -1
if index = objTables(i).na me then
set Item = objTables(i)
FoundName = True
exit for
end if
next

if FoundName = false then
err.Raise 1,"Item(index)" ,"Specified item not found!"
end if
end if
end property
end class

class clsTextSchemaTa ble
dim txtTableName
dim objFields
dim blColNameHeader
dim strFormat
dim strDelimiter
dim strCharSet

private sub Class_Initializ e
set objFields = new clsTextSchemaFi elds
blColNameHeader = false
strFormat = "Delimited"
strDelimiter = "|"
strCharSet = "ANSI"
end sub

public property Get ColumnHeaders
ColumnHeaders = blColNameHeader
end property
public property Let ColumnHeaders(t rueorfalse)
blColNameHeader = trueorfalse
end property

public property Get Format
Format = strFormat
end property
public property Let Format(newforma t)
strFormat = newFormat
end property

public property Get Delimiter
Delimiter = strDelimiter
end property
public property Let Delimiter(newDe limiter)
strDelimiter = newDelimiter
end property

Public Property Get CharSet
CharSet = strCharSet
end property
Public Property Let CharSet(NewChar Set)
strCharSet = NewCharSet
end property

public property Get Name
Name = txtTableName
end property
public property Let Name(newname)
txtTableName = newname
end property

public property Get Fields
Set Fields = objFields
end property

public Sub GetRSFields(rs)
dim objSourceField
dim ColID
dim fldName, fldType, fldSize

if isobject(rs) then
set objFields = new clsTextSchemaFi elds

ColID=0
For each objSourceField in rs.Fields

ColID = ColID+1
fldName = objSourceField. Name
if fldName = "" then fldname = Expr & ColID
fldSize = objSourceField. DefinedSize


SELECT case objSourceField. type
CASE 2 'small integer
FldType = "Short"
CASE 3
FldType = "Long"
CASE 131, 5, 128 'Numeric
FldType = "Double"
CASE 133, 135 'Date / year_month
FldType = "Date"
CASE 129, 200 'Char
FldType = "Char" '"Char Width " & cstr(field.Defi nedSize)
CASE ELSE
FldType = "Double"
end SELECT

if FldType <> "Char" then FldSize = -1

objFields.Add fldname, fldType, fldSize

next

end if
end sub

end class

class clsTextSchemaFi elds
private mCol
private intCount
private objFields()

public sub Class_Initializ e
redim objFields(0)
intCount = 0
end sub

Public property get Count()
Count = intCount
end property

'Add
public sub Add(fieldname, fieldtype, fieldSize)
intCount = intCount + 1

if (intCount-1) > ubound(objField s) then
redim preserve objFields(intCo unt-1)
end if

set objFields(intCo unt-1) = new clsTextSchemaFi eld
objFields(intCo unt-1).name = fieldname
objFields(intCo unt-1).datatype = fieldtype
objFields(intCo unt-1).size = fieldsize

end sub

'Remove
public sub Remove(id)
dim i
if (id >= 0) AND (id <= intCount-1) then
if id < intCount-1 then
for i = id to intCount-2
objFields(i) = objFields(i+1)
next
end if

intCount = intCount - 1
redim preserve objFields(intCo unt - 1)
end if
end sub

'Item
public default property get Item(index)
set Item = objFields(index )
end property
end class

class clsTextSchemaFi eld
dim txtFieldName
dim txtFieldType
dim intFieldSize

public property Get Name
Name = txtFieldName
end property
public Property Let Name(newname)
txtFieldName = newname
end property

public property Get DataType
DataType = txtFieldType
end Property
public Property Let DataType(newTyp e)
txtFieldType = newType
end property

public property Get Size
Size = intFieldSize
end Property
Public Property Let Size(newSize)
intFieldSize = newSize
end Property

end class

%>

[Rabbit]

Your coldata array has no fourth element.

[Gavin MUNJANJA]

Hi Rabbit thanks for the reply ,can you assist what statement must add on the code above im a novice in ASP today was my first day to see ASP code the person who wrote this code resigned 15 years ago what i dont understand is everything was working fine for the last 10 or so years until today afternoon when users got this error message

[Rabbit]

No idea what you have to do to fix it. There's too much missing information. Your best bet will be to step through the code line by line until you figure out why it went wrong.

[jhardman]

the subscript out of range suggests the issue is with an array and somehow you are calling for the 7th item in the array when there are only 5 items there or something like that. It doesn't make sense that this just started, maybe it was happening every once in a while and just started getting complaints. Or maybe people weren't accessing this page much before today.

Jared