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
%>