Search code examples
arraysvbscriptadosql-likerecordset

VBScript - Return a Recordset in an Array (SQL Like function)


I have to write a program for my company's accountant, and I have a problem in returning articles' families in an array, all of the families I want to have have an Accounting code who begins with "707". Here's my code in VBScript :

Set objConnection = CreateObject("ADODB.Connection")
Set rs = CreateObject("ADODB.Recordset")
objConnection.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=C:\BASES\Base.mdb;Persist Security Info=False"
rs.CursorLocation = adUseClient

FamilleQuery = "Select Code from FamilleArticle Where CptVenteFrance Like '707%'"
rs.Open FamilleQuery, objConnection, adOpenStatic, adLockOptimistic

'rs.MoveFirst
'Do
    'ListeFamille(rs.AbsolutePosition) = rs("Code")
    'rs.MoveNext
'Loop until rs.EOF

'ListeFamilleString = rs.GetString(AdClipString, -1,"/","/"," ")
'ListeFamille = split(ListeFamilleString,"/")

'Set ListeFamille = rs.GetRows

'for i=0 to ubound(rs)
    'ListeFamille(i) = rs.Fields("Code").Value(i)
'next

rs.Close
objConnection.Close

As comments you have all of my attempts to return the resultat of the recordset in an array and no one didn't work. Can someone say where I'm wrong please ?


Solution

  • Give this a try

    Option Explicit
    
    'ADO Constants
    Const adCmdText = 1
    Const adParamInput = 1
    Const adVarWChar = 202
    
    'Would usually be passed in from somewhere
    Dim value: value = "707%"
    
    Dim cmd, rs, data
    Dim conn: conn = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=C:\BASES\Base.mdb;Persist Security Info=False"
    Dim sql: sql = "Select Code from FamilleArticle Where CptVenteFrance Like ?"
    
    Set cmd = Server.CreateObject("ADODB.Command")
    With cmd
      .ActiveConnection = conn
      .CommandType = adCmdText
      .CommandText = sql
      Call .Parameters.Append(.CreateParameter("@value", adVarWChar, adParamInput, 50))      
    
      Set rs = .Execute(, Array(value))
      If Not rs.EOF Then data = rs.GetRows()
      Call rs.Close()
      Set rs = Nothing
    End With
    Set cmd = Nothing
    
    Dim row, rows
    
    If IsArray(data) Then
      'Test data (2d Array, 0 = column, 1 = row)
      Call WScript.Echo(data(0, 0))
    
      'Retrieving all rows
      rows = UBound(data, 2)
      For row = 0 To rows
        'First column from each row.
        Call WScript.Echo(data(0, row))
      Next
    Else
      'No records returned
    End If
    

    Useful Links