By using this site, you agree to our updated Privacy Policy and our Terms of Use. Manage your Cookies Settings.
438,867 Members | 1,981 Online
Bytes IT Community
+ Ask a Question
Need help? Post your question and get tips & solutions from a community of 438,867 IT Pros & Developers. It's quick & easy.

Microsoft VBScript runtime error '800a0009'

P: 2
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_Initialize
set objTables = new clsTextSchemaTables
end sub

public property get Tables
Set Tables = objTables
end property

public function TableExists(tablename)
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.CreateObject("Scripting.FilesystemObject")

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

for i = 0 to objTables.Count -1
set myTable = objTables.item(i)
schemaStrm.WriteLine "[" & myTable.name & "]"
' if myTable.blColNameHeader=true then
' schemaStrm.WriteLine "ColNameHeader=True"
' else
schemaStrm.WriteLine "ColNameHeader=False"
' end if
schemaStrm.WriteLine "Format=Delimited(|)"
schemaStrm.WriteLine "CharacterSet=ANSI"
for j = 0 to myTable.Fields.Count - 1
fielddesc = myTable.Fields.Item(j).name & " " & myTable.Fields.Item(j).DataType
if myTable.Fields.Item(j).Size <> -1 then
fielddesc = fielddesc & " Width " & myTable.Fields.Item(j).Size
end if
schemaStrm.WriteLine "Col" & j+1 & "=" & fielddesc
next
next
schemaStrm.close

end sub

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

Set objTables = new clsTextSchemaTables

set objFSO = server.CreateObject("Scripting.FileSystemObject")

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

tblCount = 0

Do while (not SchemaStrm.AtEndOfStream)
linedata = trim(SchemaStrm.Readline)
if linedata="" then
elseif (left(linedata,1) = "[") AND right(lcase(linedata),5)=".asc]" then
objTables.add mid(linedata,2,len(linedata)-2)
tblCount = tblCount + 1
set CurrentTable = objTables.item(tblCount-1)
elseif left(lcase(linedata),instr(1,linedata,"=")-1) = "colnameheader" then
currenttable.ColumnHeaders = (lcase(mid(linedata,instr(1,linedata,"=")-1))="true")
elseif left(lcase(linedata),instr(1,linedata,"=")-1) = "format" then
strFormat = trim(mid(linedata,instr(1,linedata,"=")-1))
if left(lcase(strformat),9) = "delimited" then
strDelimiter = trim(mid(strFormat,10)) 'Extract the delimiter (including brackets)
strDelimiter = mid(strDelimiter,2,len(strDelimiter)-2) 'Remove the brackets
strFormat = "Delimited"
end if
elseif left(lcase(linedata),instr(1,linedata,"=")-1) = "characterset" then
currenttable.charset = mid(linedata,instr(1,linedata,"=")-1)
elseif (left(lcase(linedata),3)="col") AND (isnumeric(mid(linedata,4,instr(1,linedata,"=")-4))) then
coldata = split(mid(linedata,instr(1,linedata,"=")+1)," ")

if tblCount > 0 then
if ubound(coldata) > 1 then
currenttable.fields.add coldata(0), coldata(1), coldata(3)
else
currenttable.fields.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.close
end sub

end class

class clsTextSchemaTables
private mCol
private intCount
private objTables()

public sub Class_Initialize
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(objTables) then
redim preserve objTables(intCount-1)
end if

set objTables(intCount-1) = new clsTextSchemaTable
objTables(intCount-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(intCount - 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).name 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 clsTextSchemaTable
dim txtTableName
dim objFields
dim blColNameHeader
dim strFormat
dim strDelimiter
dim strCharSet

private sub Class_Initialize
set objFields = new clsTextSchemaFields
blColNameHeader = false
strFormat = "Delimited"
strDelimiter = "|"
strCharSet = "ANSI"
end sub

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

public property Get Format
Format = strFormat
end property
public property Let Format(newformat)
strFormat = newFormat
end property

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

Public Property Get CharSet
CharSet = strCharSet
end property
Public Property Let CharSet(NewCharSet)
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 clsTextSchemaFields

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.DefinedSize)
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 clsTextSchemaFields
private mCol
private intCount
private objFields()

public sub Class_Initialize
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(objFields) then
redim preserve objFields(intCount-1)
end if

set objFields(intCount-1) = new clsTextSchemaField
objFields(intCount-1).name = fieldname
objFields(intCount-1).datatype = fieldtype
objFields(intCount-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(intCount - 1)
end if
end sub

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

class clsTextSchemaField
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(newType)
txtFieldType = newType
end property

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

end class

%>
Dec 1 '11 #1
Share this Question
Share on Google+
4 Replies


Rabbit
Expert Mod 10K+
P: 12,370
Your coldata array has no fourth element.
Dec 1 '11 #2

P: 2
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
Dec 1 '11 #3

Rabbit
Expert Mod 10K+
P: 12,370
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.
Dec 1 '11 #4

jhardman
Expert 2.5K+
P: 3,405
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
Dec 2 '11 #5

Post your reply

Sign in to post your reply or Sign up for a free account.