Ошибка выполнения microsoft vbscript 800a0009 - Ремонт и установка крупной бытовой техники

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) = "<a href=""" & dLink(i) & """>" & dTitle(i) & "</a>"
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!

asked Jun 16, 2012 at 14:37

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.

answered Jun 16, 2012 at 15:31

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) = "<a href=""" & dLink(i) & """>" & dTitle(i) & "</a>"
    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.

answered Jun 17, 2012 at 14:25

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) = "<a href=""" & arrVendor(cLink, i) & """>" & arr(cTitle, i) & "</a>"
    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.

answered Jun 18, 2012 at 12:49

AnthonyWJonesAnthonyWJones

187k35 gold badges232 silver badges306 bronze badges

Источник

This is my first question on here, because, although I have searched at least 15 different other posts for the answer to my issue, none have the answer. Please help!

QUESTION: How do I fix Error:800A0009?

DETAILS: I am creating a small program that gathers all local computers and sends them all an audio file to be played. Also, I need to know how to force send, if anyone knows. Lastly, I first run «Get Computers.bat».

My Code:

~~~~~~VBS FILE(Remote Speak.vbs)~~~~~~~~~~~~~~~~~~~

(Obtains variable transferred which contains network name of a computer, and sends it a file to be play using SAPI)

'get ip    
Option Explicit    
Dim args, strOut   
set args = Wscript.arguments    
strOut= args(0)    
IP = strOut

'get MSG    
MSG = InputBox("Type what you want the PC to say:", "Remote Voice Send By X BiLe", "")

If MSG = "" Then WScript.quit: Else

'vbs command to send

A = "on error resume next" & VBCRLF & _    
"CreateObject(""SAPI.SpVoice"").speak " & """" & MSG & """" & VBCRLF & _    
"CreateObject(""Scripting.FileSystemObject"").DeleteFile (""C:Voice1.vbs"")"

' Create the vbs on remote C$    
CreateObject("Scripting.FileSystemObject").OpenTextFile("\" & ip & "C$Voice1.vbs",2,True).Write A

' Run the VBS through Wscript on remote machine via WMI Object Win32_Process    
B = GetObject("winmgmts:\" & IP & "rootcimv2:Win32_Process").Create("C:windowssystem32wscript.exe ""C:Voice1.vbs""", null, null, intProcessID)

~~~BATCH PRIMARY (Get Computers.bat)~~~~~~~~~~~

(Gathers computer names and assign each one, using net view, filtering the «» to Computer%num%. Also, :tempcall is just an error handler.)

@echo off    
cls    
set num=1    
echo @echo off > Computers.bat    
if "%1"=="loop" (    
for /f "delims= tokens=*" %%a in ('net view ^| findstr /r "^\\"') do (    
set comp=%%a    
call :number    
if exist %%f exit    
)    
goto :eof    
)    
cmd /v:on /q /d /c "%0 loop"    
:tempcall    
call temp.bat    
echo.    
echo.    
echo.    
echo You have %num%computers on your network!    
pause>nul    
del /q temp.bat    
start Computers.bat    
exit    
:number    
if %comp% == "" (    
goto :tempcall    
) else (    
echo set Computer%num%=%comp% >> Computers.bat    
echo cscript "Remote Speak.vbs" %1 >> Computers.bat    
echo call "Remote Speak.vbs" >> Computers.bat    
echo set num=%num% > temp.bat    
echo Computer%num%: %comp%    
set /a num=%num% + 1    
)

BATCH SECONDARY (Computers.bat)

(The computers I made up off the top of my head, but they are generally in that format.)

@echo off    
set Computer1=040227-CYCVN1                                              
cscript "Remote Speak.vbs" //NoLogo > log.txt    
set Computer1=051448-YZVN2                                                             
cscript "Remote Speak.vbs" //NoLogo > log.txt    
pause>nul

~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~END DETAILS~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

1.) Temp.bat is literally just temporary, it’s deleted, as you can see, almost immediately after it’s created, it simply holds the value of %num% after it breaks out of the loop, because it didn’t show «You have %num%computers on your network!» correctly.

2.) Don’t worry too much about the VBScript file except for the top lines:

Option Explicit

Dim args, strOut

set args = Wscript.arguments

strOut= args(0)

IP = strOut

3.) My main issue is that I am trying to find a safe way to have «Computers.bat» call the «Remote Speak.vbs» file and set it’s batch variables to be the exact same names to refer to the individual computers, in VBScript variable format.

Источник

Remove From My Forums

Question
I have got one error in opening page inmy website, actually this sources are old and i am not familiar with this.. plz help me.. Error: Microsoft VBScript
runtime error ‘800a0009’ Subscript out of range: ‘[number: 0]’ /rescontrol/Default.asp, line 72 Plz check out here this link http://desert.somee.com/rescontrol/ Source Code can be found in http://pastebin.com/QthvEubE

Answers

- Marked as answer by
  Bruce Song
  Thursday, January 26, 2012 9:39 AM

All replies

Some support informed there is error with Microsoft access file.
- Marked as answer by
  Bruce Song
  Thursday, January 26, 2012 9:39 AM

Источник

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) = "<a href=""" & dLink(i) & """>" & dTitle(i) & "</a>"
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!

asked Jun 16, 2012 at 14:37

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.

answered Jun 16, 2012 at 15:31

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) = "<a href=""" & dLink(i) & """>" & dTitle(i) & "</a>"
    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.

answered Jun 17, 2012 at 14:25

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) = "<a href=""" & arrVendor(cLink, i) & """>" & arr(cTitle, i) & "</a>"
    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.

answered Jun 18, 2012 at 12:49

AnthonyWJonesAnthonyWJones

186k35 gold badges232 silver badges305 bronze badges

Remove From My Forums

Question
I have got one error in opening page inmy website, actually this sources are old and i am not familiar with this.. plz help me.. Error: Microsoft VBScript
runtime error ‘800a0009’ Subscript out of range: ‘[number: 0]’ /rescontrol/Default.asp, line 72 Plz check out here this link http://desert.somee.com/rescontrol/ Source Code can be found in http://pastebin.com/QthvEubE

Answers

- Marked as answer by
  Bruce Song
  Thursday, January 26, 2012 9:39 AM

All replies

Some support informed there is error with Microsoft access file.
- Marked as answer by
  Bruce Song
  Thursday, January 26, 2012 9:39 AM

I am trying to insert data in classic asp but getting following error:

Microsoft VBScript runtime error ‘800a0009’ Subscript out of range: ‘j’

For reference I am attaching my code. I am new to classic asp

IF Len(FixString(Request.Form("txtModelTypeID"))) >= 1 AND cboSlab = "SlabCombineSeries" Then

                arrModelTypeID = split(trim(Request.Form("txtModelTypeID")),",")
                arrModelID = split(trim(Request.Form("txtModelID")),",")
                arrSlab = split(trim(Request.Form("txtSlab")),",")
                arrAmount = split(trim(Request.Form("txtAmount")),",")
                arrSF = split(trim(Request.Form("txtSF")),",")
                arrNonSF = split(trim(Request.Form("txtNonSF")),",")
                arrPMY = split(trim(Request.Form("txtPMY")),",")
                arrCMY = split(trim(Request.Form("txtCMY")),",")
                arrPIY = split(trim(Request.Form("txtPIY")),",")
                arrCIY = split(trim(Request.Form("txtCIY")),",")
                arrTradeIn = split(trim(Request.Form("txtTradeIn")),",")
                arrLoyalty = split(trim(Request.Form("txtLoyalty")),",")
                arrSpecial1 = split(trim(Request.Form("txtSpecial1")),",")
                arrSpecial2 = split(trim(Request.Form("txtSpecial2")),",")
                arrSpecial3 = split(trim(Request.Form("txtSpecial3")),",")

    arrkeydiscount = split(trim(Request.Form("txtkeydiscount")),",")
    arrsme = split(trim(Request.Form("txtsme")),",")
                if ubound(arrModelTypeID) = 0 Then

                elseif ubound(arrModelTypeID) > 0 Then
                    FOR j = 0 to ubound(arrModelTypeID)

                        if NOT ISNumeric(TRIM(arrSlab(j))) Then Slab = 0 else Slab = TRIM(arrSlab(j)) end if
                        if NOT ISNumeric(TRIM(arrAmount(j))) Then Amount = 0 else Amount = TRIM(arrAmount(j))  end if
                        if NOT ISNumeric(TRIM(arrSF(j))) Then SF = 0 else SF = TRIM(arrSF(j))  end if
                        if NOT ISNumeric(TRIM(arrNonSF(j))) Then NonSF = 0 else NonSF = TRIM(arrNonSF(j))  end if
                        if NOT ISNumeric(TRIM(arrPMY(j))) Then PMY = 0 else PMY = TRIM(arrPMY(j))  end if
                        if NOT ISNumeric(TRIM(arrCMY(j))) Then CMY = 0 else CMY = TRIM(arrCMY(j))  end if
                        if NOT ISNumeric(TRIM(arrPIY(j))) Then PIY = 0 else PIY = TRIM(arrPIY(j))  end if
                        if NOT ISNumeric(TRIM(arrCIY(j))) Then CIY = 0 else CIY = TRIM(arrCIY(j))  end if
                        if NOT ISNumeric(TRIM(arrTradeIn(j))) Then TradeIn = 0 else TradeIn = TRIM(arrTradeIn(j))  end if
                        if NOT ISNumeric(TRIM(arrLoyalty(j))) Then Loyalty = 0 else Loyalty = TRIM(arrLoyalty(j))  end if
                        if NOT ISNumeric(TRIM(arrSpecial1(j))) Then Special1 = 0 else Special1 = TRIM(arrSpecial1(j))  end if
                        if NOT ISNumeric(TRIM(arrSpecial2(j))) Then Special2 = 0 else Special2 = TRIM(arrSpecial2(j))  end if
                        if NOT ISNumeric(TRIM(arrSpecial3(j))) Then Special3 = 0 else Special3 = TRIM(arrSpecial3(j))  end if
if NOT ISNumeric(TRIM(arrkeydiscount (j))) Then Key = 0 else Key = TRIM(arrkeydiscount(j))  end if
    if NOT ISNumeric(TRIM(arrsme (j))) Then Sme = 0 else Sme = TRIM(arrsme(j))  end if

                        SQL = SQL & "INSERT INTO demo_Item ( " &_
                                " iSPCMasterID, iModelID, vModelName, vModelCode, iSlab, mAmount, " &_
                                " mSF, mNonSF, mPMY, mCMY, mPIY, mCIY, mTradeIn, mLoyalty, " &_
                                " mSpecial1, mSpecial2,key_acc,sme, mSpecial3, dCreateDate, iSeq) " &_
                                " SELECT @NewID, i_modelid, vch_modelname, modelcode, " &_
                                " " & Slab & ", " &_
                                " " & Amount & ", " &_
                                " " & SF & ", " &_
                                " " & NonSF & ", " &_
                                " " & PMY & ", " &_
                                " " & CMY & ", " &_
                                " " & PIY & ", " &_
                                " " & CIY & ", " &_
                                " " & TradeIn & ", " &_
                                " " & Loyalty & ", " &_
                                " " & Special1 & ", " &_
                                " " & Special2 & ", " &_
    " " & Key & ", " &_
    " " & Sme & ", " &_
                                " " & Special3 & " , getdate(), " & j + 1 &_
                                " FROM ltr_or_models WHERE CAST(i_modeltypeid as varchar(20)) = '" & trim(arrModelTypeID(j)) &  "' " 
                    next
                end if

I am trying to insert data in classic asp but getting following error:

Microsoft VBScript runtime error ‘800a0009’ Subscript out of range: ‘j’

For reference I am attaching my code. I am new to classic asp

IF Len(FixString(Request.Form("txtModelTypeID"))) >= 1 AND cboSlab = "SlabCombineSeries" Then

                arrModelTypeID = split(trim(Request.Form("txtModelTypeID")),",")
                arrModelID = split(trim(Request.Form("txtModelID")),",")
                arrSlab = split(trim(Request.Form("txtSlab")),",")
                arrAmount = split(trim(Request.Form("txtAmount")),",")
                arrSF = split(trim(Request.Form("txtSF")),",")
                arrNonSF = split(trim(Request.Form("txtNonSF")),",")
                arrPMY = split(trim(Request.Form("txtPMY")),",")
                arrCMY = split(trim(Request.Form("txtCMY")),",")
                arrPIY = split(trim(Request.Form("txtPIY")),",")
                arrCIY = split(trim(Request.Form("txtCIY")),",")
                arrTradeIn = split(trim(Request.Form("txtTradeIn")),",")
                arrLoyalty = split(trim(Request.Form("txtLoyalty")),",")
                arrSpecial1 = split(trim(Request.Form("txtSpecial1")),",")
                arrSpecial2 = split(trim(Request.Form("txtSpecial2")),",")
                arrSpecial3 = split(trim(Request.Form("txtSpecial3")),",")

    arrkeydiscount = split(trim(Request.Form("txtkeydiscount")),",")
    arrsme = split(trim(Request.Form("txtsme")),",")
                if ubound(arrModelTypeID) = 0 Then

                elseif ubound(arrModelTypeID) > 0 Then
                    FOR j = 0 to ubound(arrModelTypeID)

                        if NOT ISNumeric(TRIM(arrSlab(j))) Then Slab = 0 else Slab = TRIM(arrSlab(j)) end if
                        if NOT ISNumeric(TRIM(arrAmount(j))) Then Amount = 0 else Amount = TRIM(arrAmount(j))  end if
                        if NOT ISNumeric(TRIM(arrSF(j))) Then SF = 0 else SF = TRIM(arrSF(j))  end if
                        if NOT ISNumeric(TRIM(arrNonSF(j))) Then NonSF = 0 else NonSF = TRIM(arrNonSF(j))  end if
                        if NOT ISNumeric(TRIM(arrPMY(j))) Then PMY = 0 else PMY = TRIM(arrPMY(j))  end if
                        if NOT ISNumeric(TRIM(arrCMY(j))) Then CMY = 0 else CMY = TRIM(arrCMY(j))  end if
                        if NOT ISNumeric(TRIM(arrPIY(j))) Then PIY = 0 else PIY = TRIM(arrPIY(j))  end if
                        if NOT ISNumeric(TRIM(arrCIY(j))) Then CIY = 0 else CIY = TRIM(arrCIY(j))  end if
                        if NOT ISNumeric(TRIM(arrTradeIn(j))) Then TradeIn = 0 else TradeIn = TRIM(arrTradeIn(j))  end if
                        if NOT ISNumeric(TRIM(arrLoyalty(j))) Then Loyalty = 0 else Loyalty = TRIM(arrLoyalty(j))  end if
                        if NOT ISNumeric(TRIM(arrSpecial1(j))) Then Special1 = 0 else Special1 = TRIM(arrSpecial1(j))  end if
                        if NOT ISNumeric(TRIM(arrSpecial2(j))) Then Special2 = 0 else Special2 = TRIM(arrSpecial2(j))  end if
                        if NOT ISNumeric(TRIM(arrSpecial3(j))) Then Special3 = 0 else Special3 = TRIM(arrSpecial3(j))  end if
if NOT ISNumeric(TRIM(arrkeydiscount (j))) Then Key = 0 else Key = TRIM(arrkeydiscount(j))  end if
    if NOT ISNumeric(TRIM(arrsme (j))) Then Sme = 0 else Sme = TRIM(arrsme(j))  end if

                        SQL = SQL & "INSERT INTO demo_Item ( " &_
                                " iSPCMasterID, iModelID, vModelName, vModelCode, iSlab, mAmount, " &_
                                " mSF, mNonSF, mPMY, mCMY, mPIY, mCIY, mTradeIn, mLoyalty, " &_
                                " mSpecial1, mSpecial2,key_acc,sme, mSpecial3, dCreateDate, iSeq) " &_
                                " SELECT @NewID, i_modelid, vch_modelname, modelcode, " &_
                                " " & Slab & ", " &_
                                " " & Amount & ", " &_
                                " " & SF & ", " &_
                                " " & NonSF & ", " &_
                                " " & PMY & ", " &_
                                " " & CMY & ", " &_
                                " " & PIY & ", " &_
                                " " & CIY & ", " &_
                                " " & TradeIn & ", " &_
                                " " & Loyalty & ", " &_
                                " " & Special1 & ", " &_
                                " " & Special2 & ", " &_
    " " & Key & ", " &_
    " " & Sme & ", " &_
                                " " & Special3 & " , getdate(), " & j + 1 &_
                                " FROM ltr_or_models WHERE CAST(i_modeltypeid as varchar(20)) = '" & trim(arrModelTypeID(j)) &  "' " 
                    next
                end if

Недавно я унаследовал веб-сайт в ASP, с которым я не знаком. Вчера на одной из страниц стала выдавать ошибку:

Microsoft VBScript runtime error '800a0009'

Subscript out of range: 'i'

default.asp, line 19

Вот код из строк 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) = "<a href=""" & dLink(i) & """>" & dTitle(i) & "</a>"
if NOT rs.EOF then rs.movenext
Loop
x = i

rs.Close : Set rs = Nothing
%>

Любые идеи о том, что здесь происходит и как я могу это исправить?

Спасибо!

3 ответы

Вы объявили dTitle, dDescription и dLink как массивы размером 100. Просматривая набор записей, вы назначаете элементы этим массивам. Может показаться, что в вашем наборе записей более 100 записей, поэтому логика пытается сделать что-то вроде:

dTitle(101) = rs.fields.item("dTitle").value

Это вызовет ошибку, потому что ваш массив недостаточно велик для хранения всех ваших данных.

Создан 16 июн.

Выбранное вами «решение» не очень хорошее. А если через 2 года их будет больше 500? Вы забудете обо всем этом и снова потратите часы.

Вместо массивов фиксированного размера вы можете просто использовать динамические массивы:

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) = "<a href=""" & dLink(i) & """>" & dTitle(i) & "</a>"
    End If
    rs.movenext
Loop

Это начнется с одного (пустого) элемента в каждом массиве — по какой-то причине коду это нужно — затем на каждой итерации будет добавляться еще один элемент, сохраняя остальные.

Обратите внимание, что я также исправил небольшую проблему, которая могла вызвать проблемы: в случае значения NULL в поле «dLink» вы получите пустые привязки в своем HTML, потому что NULL не является пустой строкой в VBScript.

Создан 17 июн.

Это как GetRows можно использовать для достижения той же цели.

<% 

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) = "<a href=""" & arrVendor(cLink, i) & """>" & arr(cTitle, i) & "</a>"
    End If 
Next

%>

Ноты:

Оператор Select содержит только те поля, которые необходимы в результатах, следует избегать использования *.
Параметризованная команда используется, чтобы избежать угрозы SQL-инъекции из-за контакта с SQL.
Константы, используемые для индексов полей в результирующем двумерном массиве.
Хотя этот код повторяет исходное изменение значения заголовка, он приведен здесь только в качестве примера. На самом деле создание HTML должно быть оставлено как можно позже, а вывод всех таких строк, как заголовок и описание, должен быть пропущен через Server.HTMLEncode перед отправкой в ответ.

Создан 18 июн.

Не тот ответ, который вы ищете? Просмотрите другие вопросы с метками

asp-classic
runtime-error

or задайте свой вопрос.

May 12th, 2010, 09:06 AM

#1

Thread Starter

New Member

[RESOLVED] VBScript runtime error 800a0009

Fixed so removing the code

Last edited by coolgirl; May 12th, 2010 at 01:17 PM.
May 12th, 2010, 10:58 AM

#2

Re: VBScript runtime error 800a0009

The «Subscript out of Range» error means you’re trying to access an element of an array that doesn’t exist; like if your array has 3 elements, and you try to access the 4th element. On line 123, you’re using the aAppSrvs() array, which was defined as aAppSrvs(100,100), and the error message is telling you that «101» was used as either i or j. You either need to dim aAppSrvs with higher bounds, or you need to find out what’s causing i or j to be 101 when they’re expected to stay less than or equal to 100.
May 12th, 2010, 11:47 AM

#3

Re: VBScript runtime error 800a0009

I assume this query is probably returning more than 101 record which will make the loop go beyond the bounds that you have delcared for the i dimension.

72 sSQL = «SELECT e.* FROM tblEnvironment e WITH (nolock) WHERE e.RealEnvironment = 1 » _
73 & «and e.EnvironmentActive = 1 ORDER BY e.SortOrder»
May 12th, 2010, 12:18 PM

#4

Thread Starter

New Member

Re: VBScript runtime error 800a0009

Originally Posted by MarkT

I assume this query is probably returning more than 101 record which will make the loop go beyond the bounds that you have delcared for the i dimension.

72 sSQL = «SELECT e.* FROM tblEnvironment e WITH (nolock) WHERE e.RealEnvironment = 1 » _
73 & «and e.EnvironmentActive = 1 ORDER BY e.SortOrder»

So what values should i change to make it work.

I tried to change line # 27 value of svrs_per_env = 100 to 200 but still it did not work.
May 12th, 2010, 12:19 PM

#5

Thread Starter

New Member

Re: VBScript runtime error 800a0009

Originally Posted by coolgirl

So what values should i change to make it work.

I tried to change line # 27 value of svrs_per_env = 100 to 200 but still it did not work.

Select by Application works fine but when I click select by Environment it gives me this error.
May 12th, 2010, 12:53 PM

#6

Re: VBScript runtime error 800a0009

Give this a try.
Change line 38 from
Dim aAppSrvs(100, 100)
to
Dim aAppSrvs()

then at line 119 add
Redim aAppSrvs(UBound(aColumns), SVRS_PER_ENV)

You will also have to update the code for aAppSrvsColor in the same way.
May 12th, 2010, 01:00 PM

#7

Thread Starter

New Member

Re: VBScript runtime error 800a0009

Originally Posted by MarkT

Give this a try.
Change line 38 from
Dim aAppSrvs(100, 100)
to
Dim aAppSrvs()

then at line 119 add
Redim aAppSrvs(UBound(aColumns), SVRS_PER_ENV)

You will also have to update the code for aAppSrvsColor in the same way.

I tried Dim aAppSrvs(200, 200) and also for aAppSrvsColor(200, 200) and it worked.

Thanks all for your help!
May 12th, 2010, 01:08 PM

#8

Re: VBScript runtime error 800a0009

and it will continue to work until you return more than 201 records.

Remove From My Forums

Question
hi, i’m trying to get data from two dimensional array. here is my code:

strSQL11 = «SELECT count(*) as XX FROM DEALER_OFFERS where clientId=’»+centerNum +»‘;»

set rst22 = mobjConn.execute(strSQL11)

arraySize=rst22(«XX»)

i=0

dim offersTemp()

strSQL3 = «SELECT OFFER_DESC,OFFER_CODE FROM DEALER_OFFERS where clientId=’»+myDealerInfo.clientId +»‘ order by offer_code;»

ReDim Preserve offersTemp(arraySize,2)

set rst3 = mobjConn.execute(strSQL3)

Do while not rst3.eof

offersTemp(i,0) = rst3(«OFFER_CODE»)

offersTemp(i,1) = rst3(«OFFER_DESC»)

i=i+1

rst3.movenext

loop

myDealerInfo.offers = offersTemp

in the above code i’m taking the data from the DB.

in the next code i’m trying to show it on my screen(my website):

<%Dim offerNum

offerNum = ubound(mydealerInfo.offers)%>

<b>We Offer:</b>

<ul type=»square» style=»margin-left: 15px; padding-left: 0px; margin-top: 0px;»>

<%For i=0 to offerNum

If mydealerInfo.offers(i,1) <> «» and mydealerInfo.offers(i,0) = «1000» Then%>

<a href = «totalCarCare.asp?centerNum='<%=mydealerInfo.dealerNum%>’&request= class=»linkWeekSpec2»><%=mydealerInfo.offers(i,1)%></a><%

Response.Write «
<li>»& mydealerInfo.offers(i,1) & «</li>»

Else If mydealerInfo.offers(i,1) <> «» and mydealerInfo.offers(i,0) <> «1000» Then

Response.Write «
<li>»& mydealerInfo.offers(i,1) & «</li>»

End If

End If

Next%>

my full error is this:

Microsoft VBScript runtime
error ‘800a0009’

Subscript out of range: ‘i’

/d6-test/x.js, line 146

when line 146 is this : offersTemp(i,0) = rst3(«OFFER_CODE»)

please help!!!!

thanks!
- Moved by
  Thursday, May 20, 2010 10:10 AM
  Wrong Forum (From:Internet Explorer)
- Moved by
  Martin_Xie
  Tuesday, May 25, 2010 10:29 AM
  Redirect to related VBScript forum for better responses. (From:Visual Basic General)

Это мой первый вопрос здесь, потому что, хотя я просмотрел по крайней мере 15 других постов в поисках ответа на свой вопрос, ни у кого нет ответа. Пожалуйста помоги!

ВОПРОС: Как исправить Ошибку: 800A0009?

ПОДРОБНОСТИ: Я создаю небольшую программу, которая собирает все локальные компьютеры и отправляет им всем аудиофайл для воспроизведения. Также мне нужно знать, как принудительно отправить, если кто знает. Наконец, я сначала запускаю «Get Computers.bat».

Мой код:

~~~~~~ФАЙЛ VBS(Remote Speak.vbs)~~~~~~~~~~~~~~~~~~~

(Получает переданную переменную, содержащую сетевое имя компьютера, и отправляет ему файл для воспроизведения с использованием SAPI)

'get ip    
Option Explicit    
Dim args, strOut   
set args = Wscript.arguments    
strOut= args(0)    
IP = strOut

'get MSG    
MSG = InputBox("Type what you want the PC to say:", "Remote Voice Send By X BiLe", "")

If MSG = "" Then WScript.quit: Else

'vbs command to send

A = "on error resume next" & VBCRLF & _    
"CreateObject(""SAPI.SpVoice"").speak " & """" & MSG & """" & VBCRLF & _    
"CreateObject(""Scripting.FileSystemObject"").DeleteFile (""C:Voice1.vbs"")"

' Create the vbs on remote C$    
CreateObject("Scripting.FileSystemObject").OpenTextFile("" & ip & "C$Voice1.vbs",2,True).Write A

' Run the VBS through Wscript on remote machine via WMI Object Win32_Process    
B = GetObject("winmgmts:" & IP & "rootcimv2:Win32_Process").Create("C:windowssystem32wscript.exe ""C:Voice1.vbs""", null, null, intProcessID)

~~~BATCH PRIMARY (Получить Computers.bat)~~~~~~~~~~~

(Собирает имена компьютеров и присваивает каждому из них, используя net view, фильтруя «» до Computer%num%. Кроме того, :tempcall — это просто обработчик ошибок.)

@echo off    
cls    
set num=1    
echo @echo off > Computers.bat    
if "%1"=="loop" (    
for /f "delims= tokens=*" %%a in ('net view ^| findstr /r "^\"') do (    
set comp=%%a    
call :number    
if exist %%f exit    
)    
goto :eof    
)    
cmd /v:on /q /d /c "%0 loop"    
:tempcall    
call temp.bat    
echo.    
echo.    
echo.    
echo You have %num%computers on your network!    
pause>nul    
del /q temp.bat    
start Computers.bat    
exit    
:number    
if %comp% == "" (    
goto :tempcall    
) else (    
echo set Computer%num%=%comp% >> Computers.bat    
echo cscript "Remote Speak.vbs" %1 >> Computers.bat    
echo call "Remote Speak.vbs" >> Computers.bat    
echo set num=%num% > temp.bat    
echo Computer%num%: %comp%    
set /a num=%num% + 1    
)

ВТОРИЧНЫЙ ПАКЕТ (Computers.bat)

(Компьютеры я выдумал наугад, но обычно они в таком формате.)

@echo off    
set Computer1=040227-CYCVN1                                              
cscript "Remote Speak.vbs" //NoLogo > log.txt    
set Computer1=051448-YZVN2                                                             
cscript "Remote Speak.vbs" //NoLogo > log.txt    
pause>nul

~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~КОНЕЦ ПОДРОБНОСТИ~~~~~~~~~~~~~~ ~~~~~~~~~~~~~~~~~~~~~~~

1.) Temp.bat буквально временный, он удаляется, как видите, почти сразу после создания, он просто хранит значение %num% после выхода из цикла, потому что не показывает «Вы иметь %num%computers в вашей сети!» правильно.

2.) Не слишком беспокойтесь о файле VBScript, за исключением верхних строк:

Option Explicit

Dim args, strOut

set args = Wscript.arguments

strOut= args(0)

IP = strOut

3.) Моя основная проблема заключается в том, что я пытаюсь найти безопасный способ, чтобы «Computers.bat» вызывал файл «Remote Speak.vbs» и устанавливал его пакетные переменные так, чтобы они были точно такими же именами для ссылки на отдельные компьютеры, в формате переменной VBScript.

Источник

Solution 1

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.

Solution 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) = "<a href=""" & dLink(i) & """>" & dTitle(i) & "</a>"
    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.

Solution 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) = "<a href=""" & arrVendor(cLink, i) & """>" & arr(cTitle, i) & "</a>"
    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.

Comments

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) = "<a href=""" & dLink(i) & """>" & dTitle(i) & "</a>"
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!

Recents

Источник

Question

Answers

All replies

Question

Answers

All replies

3 ответы

[RESOLVED] VBScript runtime error 800a0009

Re: VBScript runtime error 800a0009

Re: VBScript runtime error 800a0009

Re: VBScript runtime error 800a0009

Re: VBScript runtime error 800a0009

Re: VBScript runtime error 800a0009

Re: VBScript runtime error 800a0009

Re: VBScript runtime error 800a0009

Question

Solution 1

Solution 2

Solution 3

Comments

Recents

Related