473,320 Members | 2,107 Online
Bytes | Software Development & Data Engineering Community
Post Job

Home Posts Topics Members FAQ

Join Bytes to post your question to a community of 473,320 software developers and data experts.

Microsoft VBScript runtime error '800a0009'

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
4 4856
Rabbit
12,516 Expert Mod 8TB
Your coldata array has no fourth element.
Dec 1 '11 #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
12,516 Expert Mod 8TB
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
3,406 Expert 2GB
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

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

Similar topics

10
by: | last post by:
I am accessing the same error-containing ASP page on an ISP server using w2k IE6 but with different effect. On the first computer I get several line of HTML outputed by ASP, shown correctly by...
3
by: Mike Kanski | last post by:
I get this error Microsoft VBScript runtime error '800a01fb' When i call LoadPicture method, or when i pretty much do any operation with PictureBox like setting width and height. It happened...
10
by: Seeker | last post by:
Hi! I have to do some developing and I'm trying to configure my server to mimic the operation of our production server. The issue I'm having is that I'm trying to use CDONTS to send an email...
1
by: Matrix | last post by:
I just got one virtual directory setup and try to run my web application from there. I am getting following error Microsoft VBScript runtime error '800a01a8' Object required: 'Session' I even...
1
by: PaulieS | last post by:
Hi all. Am migrating a customer from IIS5 on W2K server to IIS6 on W2K3. Zipped all the websites and unzipped them to the identical locations on new server. Used IISMT to migrate metabase. ...
2
by: anidmarty | last post by:
Hey I'm a Sysadmin and my users are getting this error on my production box. It works fine on the dev box. There is a script that is run that generates this error. Production is clustered...
0
by: =?Utf-8?B?TWF0dCBDYWxob29u?= | last post by:
HI there, I am getting an error on my page which calls up a web service. Microsoft VBScript runtime error '800a13ba' Unknown runtime error: 'SearchQueryXML' /SearchResults.asp, line 142
1
by: Concheso | last post by:
Hi there! I just created a login page. 1/3 of the login works fine, but some like "Lost Password" of "Admin access to add users" are not working. Any help will be great! The erros: On...
0
by: .nLL | last post by:
Erorr is --------------------- Microsoft VBScript runtime error '800a0046' Permission denied /a.asp, line 3 -----------------------
1
by: morrisqueto | last post by:
Hello, One of my websites just started sending a new rare error. The site has been working for almost 2 years without trouble, but today morning started giving away this error in all my views. ...
0
by: ryjfgjl | last post by:
ExcelToDatabase: batch import excel into database automatically...
0
isladogs
by: isladogs | last post by:
The next Access Europe meeting will be on Wednesday 6 Mar 2024 starting at 18:00 UK time (6PM UTC) and finishing at about 19:15 (7.15PM). In this month's session, we are pleased to welcome back...
1
isladogs
by: isladogs | last post by:
The next Access Europe meeting will be on Wednesday 6 Mar 2024 starting at 18:00 UK time (6PM UTC) and finishing at about 19:15 (7.15PM). In this month's session, we are pleased to welcome back...
0
by: Vimpel783 | last post by:
Hello! Guys, I found this code on the Internet, but I need to modify it a little. It works well, the problem is this: Data is sent from only one cell, in this case B5, but it is necessary that data...
1
by: PapaRatzi | last post by:
Hello, I am teaching myself MS Access forms design and Visual Basic. I've created a table to capture a list of Top 30 singles and forms to capture new entries. The final step is a form (unbound)...
0
by: Defcon1945 | last post by:
I'm trying to learn Python using Pycharm but import shutil doesn't work
0
by: af34tf | last post by:
Hi Guys, I have a domain whose name is BytesLimited.com, and I want to sell it. Does anyone know about platforms that allow me to list my domain in auction for free. Thank you
0
by: Faith0G | last post by:
I am starting a new it consulting business and it's been a while since I setup a new website. Is wordpress still the best web based software for hosting a 5 page website? The webpages will be...
0
isladogs
by: isladogs | last post by:
The next Access Europe User Group meeting will be on Wednesday 3 Apr 2024 starting at 18:00 UK time (6PM UTC+1) and finishing by 19:30 (7.30PM). In this session, we are pleased to welcome former...

By using Bytes.com and it's services, you agree to our Privacy Policy and Terms of Use.

To disable or enable advertisements and analytics tracking please visit the manage ads & tracking page.