How to add to an array from within a function in VBScript?

Question

I'm having trouble writing a function that will output an array of records. What I am attempting to do is call a function that gets all the records in a table and will create a multi-dimensional array that I can use in the page that calls the function.

Can you tell me what I'm doing wrong?

 function get_admins 
    set rs = Server.CreateObject("ADODB.recordset")
    rs.cursorType = 3
    getsql = "select * from users order by name asc"
    rs.Open getsql, conn
    total = rs.RecordCount
    ra = array
    c = 0
    if total < 1 then 
        o = "There are no admins yet."
    else
        do until rs.EOF
        id = rs.Fields("id").value
        username = rs.Fields("username").value
        adminname = rs.Fields("name").value
        email = rs.Fields("email").value

        Redim Preserve ra(c,4) '<-- This is the line the error doesn't like
    ra(c,0) = id
    ra(c,1) = username
    ra(c,2) = adminname
    ra(c,3) = email
    c = c + 1

        rs.MoveNext
        loop

       end if
      rs.close
      get_admins = ra
    end function

This is the error I get:

Microsoft VBScript runtime error '800a0009'

Subscript out of range

Function call on the page looks like this:

<pre><%
        dim seeme 
    set seeme = get_admins
%></pre>

Here are some similar questions I found:

Classic ASP 3.0 Create Array from a Recordset - Helped a lot, but not quite there.

Redim Preserve gives 'subscript out of range' - This one just straight confused me.

@AnsgarWiechers - thanks. I guess that would be the problem. — ckpepper02, Jul 25 '13 at 19:59

Ansgar Wiechers · Accepted Answer · 2013-07-25T21:52:45.647

ReDim Preserve can only change the size of the last dimension in multidimensional arrays, so it's not really useful in your situation. What you can use is an array of arrays, though:

ReDim ra(-1)  'initialize record array as empty array
...
Else
  Do Until rs.EOF
    ReDim va(3)  'initialize value array (clear values)
    va(0) = rs.Fields("id").value
    va(1) = rs.Fields("username").value
    va(2) = rs.Fields("name").value
    va(3) = rs.Fields("email").value

    Redim Preserve ra(UBound(ra)+1) 'grow record array
    ra(UBound(ra)) = va             'put value array into record array

    rs.MoveNext
  Loop
End If

That will allow you to access the elements of the nested arrays like this:

WScript.Echo ra(3)(1)

The above will print the 2^nd value (index 1) from the 4^th nested array (index 3).

As for returning the array, you cannot use the Set keyword in the assignment:

set seeme = get_admins   '<-- will fail!

That's because that keyword is reserved for object assignments and arrays aren't objects. Change that line to this:

seeme = get_admins

Thank you VERY much!! I was at wit's end. That solved my problem. — ckpepper02, Jul 25 '13 at 20:44
@Ansgar - That's a (hard) working solution, but please take back your claim that you can't ReDim Preserve multidimensional arrays. — Ekkehard.Horner, Jul 25 '13 at 21:22
@Ekkehard.Horner Granted, you can resize the last dimension. I'm not aware of a way to resize the other dimensions. — Ansgar Wiechers, Jul 25 '13 at 21:58

Ekkehard.Horner · Answer 2 · 2013-07-25T21:21:11.177

Instead of rolling your own, look at the .GetRows method.

To put some code behind my claim:

  Dim oTCN  : Set oTCN = CreateObject( "ADODB.Connection" )
  Dim sTDir : sTDir    = "M:\lib\kurs0705\testdata\txt"  ' <-- ohne \ am Ende!
  Dim sCS   : sCS      = Join( Array( _
                                "Provider=MSDASQL" _
                              , "Driver={Microsoft Text Driver (*.txt; *.csv)}" _
                              , "DBQ=" & sTDir _
                         ), ";" )
  oTCN.Open sCS
  Dim oRS
  Set oRS = oTCN.Execute("SELECT TOP 3 * FROM [gendata.txt]")
  Dim nUB : nUB = oRS.Fields.Count - 1
  ReDim aRow(nUB) ' array for one row
  ReDim aRows(nUB, -1) ' 2nd dim growable array for all rows
  Dim f
  For f = 0 To UBound(aRow)
      aRow(f) = oRS.Fields(f).Name
  Next
  WScript.Echo Join(aRow, ",")
  Do Until oRS.EOF
     ReDim Preserve aRows(nUB, UBound(aRows, 2) + 1)
     For f = 0 To UBound(aRow)
         aRow(f) = oRS.Fields(f).Value
         aRows(f, UBound(aRows, 2)) = oRS.Fields(f).Value
     Next
     WScript.Echo Join(aRow, ",")
     oRS.MoveNext
  Loop
  oRS.MoveFirst
  Dim aMagic : aMagic = oRS.GetRows() ' this is all you need!
  Dim r, c
  For r = 0 To UBound(aMagic, 2)
      For c = 0 To UBound(aMagic, 1)
          WScript.Echo r, c, aMagic(c, r), aRows(c, r)
      Next
      WScript.Echo
  Next

  oTCN.Close

output:

=============================================================
iID,sFrsName,sLstName,sSex,dtBirth
1,Yqiqpbcmunrzvi,Pmyqcxfoffrfnwbd,U,8/7/2008
2,Viyvfshpxu,Xjtfbjuiiwojhyjwkefcu,U,7/27/2008
3,Hoocyseiiiawrt,Mrpuhzuhysslzhwhnpp,F,8/7/2008
0 0 1 1
0 1 Yqiqpbcmunrzvi Yqiqpbcmunrzvi
0 2 Pmyqcxfoffrfnwbd Pmyqcxfoffrfnwbd
0 3 U U
0 4 07.08.2008 07.08.2008

1 0 2 2
1 1 Viyvfshpxu Viyvfshpxu
1 2 Xjtfbjuiiwojhyjwkefcu Xjtfbjuiiwojhyjwkefcu
1 3 U U
1 4 27.07.2008 27.07.2008

2 0 3 3
2 1 Hoocyseiiiawrt Hoocyseiiiawrt
2 2 Mrpuhzuhysslzhwhnpp Mrpuhzuhysslzhwhnpp
2 3 F F
2 4 07.08.2008 07.08.2008

=============================================================

So - contrary to Ansgar's "You can't use ReDim Preserve on multidimensional arrays" - you can grow the last dimension of an multidimensional array. That means you have to grow the rows and layout your array in a col/row instead of the more 'natural' row/col structure.

aRows shows how you roll your own .GetRows correctly. Of course the sane strategy is to use, as in

Dim aMagic : aMagic = oRS.GetRows() ' this is all you need!

How to add to an array from within a function in VBScript?

2 Answers2