Retrieve Records from Stored Procedure

[MrDeej]

Hello my good people!

It have come to my mind that stored procedures can help us speed up the retrival of records from our SQL server.

I have now made a stored procedure at our server which is called "StoreProcedure1"

normally i would use this code to populate listboxes with information. I would prefer to use a stored procedure cause of the speed advantage i think it has.

Sub Populer_Liste_avansert(SQL As String, Skjema As String, Liste As String)
Dim r As DAO.Recordset
Dim Coll As New Collection
Dim Tmpstr As String
Dim Fieldstr As Long
 
'--------------------------
'Åpne recordset
'--------------------------
 
Set r = CurrentDb.OpenRecordset(SQL, dbOpenSnapshot, dbSeeChanges)
 
'--------------------------
'Finn overskrifter
'--------------------------
For x = 1 To r.Fields.Count
    Coll.ADD (r.Fields(x - 1).Name)
Next x
 
'--------------------------
'Lag en string med overskriftene
'--------------------------
For x = 1 To Coll.Count
    If Not Tmpstr = "" Then
        Tmpstr = Tmpstr & ";" & Coll(x)
    Else
        Tmpstr = Coll(x)
    End If
Next x
 
'--------------------------
'Endre kildetype på listen
'--------------------------
Forms(Skjema).Controls(Liste).RowSourceType = "Verdiliste"
 
'--------------------------
'Sett inn overskriftene i listen
'--------------------------
Forms(Skjema).Controls(Liste).RowSource = ""
Forms(Skjema).Controls(Liste).AddItem Tmpstr
 
'--------------------------
'Hent og sett inn verdiene
'--------------------------
 
'--------------------------
'Gå gjennom alle postene
'--------------------------
Do Until r.EOF
    I = I + 1
    '--------------------------
    'Tøm Coll
    '--------------------------
    For x = 1 To Coll.Count
        Coll.Remove (1)
    Next x
 
    '--------------------------
    'Hent verdier
    '--------------------------
    For x = 1 To r.Fields.Count
        Coll.ADD (r.Fields(x - 1).Value)
    Next x
 
    '--------------------------
    'Lag string
    '--------------------------
    Tmpstr = ""
    For x = 1 To Coll.Count
        If Not Tmpstr = "" Then
            Tmpstr = Tmpstr & ";" & Coll(x)
        Else
            Tmpstr = Coll(x)
        End If
    Next x
 
    '------------------------------------
    'Sjekk om max listeinnhold er oppnådd
    '------------------------------------
    Fieldstr = Fieldstr + Len(Tmpstr)
    If Fieldstr > 32736 Then
        imax = 200
        GoTo slutt
    End If
 
    '--------------------------
    'Sett inn post i listen
    '--------------------------
    Forms(Skjema).Controls(Liste).AddItem Tmpstr
 
    r.MoveNext
Loop
 
slutt:
r.Close
 
 
Set rs = Nothing
Set Coll = Nothing
 
 
End Sub
 
 
 
 

Can anyone help me on how to open a stored procedure and running trough all the records and retriving the data. The collection and all that you need not to think of, just how to open the procedure and retrive all the rows from it

[Jim Doherty]

@MrDeej
In your mdb file Create a passthrough query you can either do that hardwired into your database as a saved query where the connection string is stored with the query ( my guess is you will not want this given the clutter it involves by having small queries taking up the database window) or you can create it in code and either save it(in code) so it becomes part of your database or run it as a 'temporary' query (ie a created querydef with no name "") in memory for the period of your code flow then destroy. You can then open your recordset in the usual way based on that persisted or temporary querydef.

Given your workflow is seemingly code based look at CreateQueryDef and manipulate the .SQL property and .ReturnsRecords property of the query object as you create it.

So.... in essence the only command that exists in the SQL Window of the passthrough would be StoredProcedure1 (if you are passing parameters as part of that process then you merely append to that string the relevant parameter 'values' (each value delimited by a comma and each value wrapped with a quote mark) via your code so that the server can execute it.

DAO and ADO have obvious differences in approach to this but given your post mentions DAO I will leave it at that for the moment.

[NeoPa]

I expect your earlier code worked with Access objects, so DAO would be fine. Working with objects in SQL Server you probably want to switch over to ADODB I would suggest.

[MrDeej]

@Jim Doherty
Thank you Jim Doherty. Pass-trough query did the job, it is considerably faster when i open my left joined table with 1 million posts :=)

Thanks a million.

Here is a good link for finding the walktrough by m$
http://support.microsoft.com/kb/303968

And NeoPa: Could you ellaborate? We also use ADO to populate listboxes, but by experience there are some functions that doesnt work with ADO that works with DAO and vice versa, the code i posted farther up is just 1 of 5 elements in on user-function

[Jim Doherty]

@MrDeej
Hi, Glad you sorted,

The MS walkthrough highlights the steps you can take inserting SQL in the passthrough SQL Window. What it does not outline unfortunately which would in my opinion be of benefit for the uninitiated, is that you can simply place the 'name' of the stored procedure in the passthrough SQL window.

Given the SQL for a stored procedure is actually resident on the server and not the client it would NOT necessarily be glaringly obvious to the newbie reader that simply entering the stored procedure name in the Access passthrough window in the manner suggested would work, which of course it does.

I add this because typing in a whole load of SQL on the client machine is unnecessary if you place it in a centralised procedure on the server (where it becomes part of a pre-compiled optimised server execution plan and thus more efficient) and simply reference the procedure name itself!

In addition to this and if speed is part of the issue, have a look at server optimisation hints noteably WITH (NOLOCK). This hint tells the server not to place a lock on the tempDB during data retrieval. I won't elaborate for fear of overkill here at this juncture, but you will notice a marked improvement because it provides data without reference to the state of 'current edits' of the source data. Some websites amongst others could benefit from this in my view, where mainly 'read only' is sent to a page. But do research please on the 'ups and downs' of how and where to use it and benchmark at your leisure of course.

Jim :)

[NeoPa]

DAO = Data Access Objects
ADODB = ActiveX Data Objects for DataBases

DAO was designed specifically with Jet/Access in mind, therefore it works well within Access and supports the settings that you need for working with Access (and Jet. Jet is basically the database SQL engine for Access).

When you are dealing with database objects outside of Access, the more portable, more standard, ADODB, is probably better.

If you have a SQL Server or Oracle back-end database for instance, ADODB is a more appropriate tool. If the back-end is in Access however, ADO is probably a better fit.

[MrDeej]

A lot of work done now, but it works as hell.

For special interested people i post my code


First the user interface:

To make wherestring based on textboxes above listbox:

Function Opprett_Where_utrykk_SP(Where As String, Skjema As String, tbxnavn As String, Verdi As String, Liste As String, Optional Avansert As String) As String
 
Dim Indikator As String
Dim VerdiUtenIndikator As String
Dim VerdiTall As Long
Dim Felt As String
Dim WildCardTegn As String
Dim IndiKatorLeft As String
Dim IndiKatorRight As String
 
'navnet til feltet i tabell som skal filtereres baser på overskrit i listen
If IsNumeric(Right(tbxnavn, 2)) Then
    Felt = "[" & Forms(Skjema).Controls(Liste).Column(Right(tbxnavn, 2), 0) & "]"
Else
    Felt = "[" & Forms(Skjema).Controls(Liste).Column(Right(tbxnavn, 1), 0) & "]"
End If
 
'''''''''''''''''''''''''''''''''''''
'Fastsetting av tabell som felt hører til på spørringer som har flere felt med samme navn
'''''''''''''''''''''''''''''''''''''
If Skjema = "INFO Lokasjonstransaksjoner" Then
    If tbxnavn = "tbx 1" Then
    Felt = "ACD_user.[Lok Loksummer - flytthistorikk].varenr"
    End If
End If
 
'''''''''''''''''''''''''''''''''''''
'Sjekker om det allerede er laget et where, isåfall så brukes AND mellom dem
'''''''''''''''''''''''''''''''''''''
 
If Where = "" Then
    Opprett_Where_utrykk_SP = " Where "
Else
    Opprett_Where_utrykk_SP = Where & " AND "
End If
 
 
WildCardTegn = "%"
'''''''''''''''''''''''''''''''''''''
'Indikator er om det er noen spesielle fortegn på filter feltet. F. eks = eller > (større enn)
'''''''''''''''''''''''''''''''''''''
 
 
'''''''''''''''''''''''''''''''''''''
'Indikator er om det er noen spesielle fortegn på filter feltet. F. eks = eller > (større enn)
'''''''''''''''''''''''''''''''''''''
Indikator = Left(Verdi, 1)
VerdiUtenIndikator = Mid(Verdi, 2)
 
If Left(Verdi, 2) = "<>" Then
    Indikator = Left(Verdi, 2)
    VerdiUtenIndikator = Mid(Verdi, 3)
End If
 
If Indikator = "=" Or Indikator = "<" Or Indikator = ">" Then
    If IsDate(VerdiUtenIndikator) Then
        Opprett_Where_utrykk_SP = Opprett_Where_utrykk_SP & Felt & Indikator & "CONVERT(DATETIME,'" & VerdiUtenIndikator & "',104)"
        Else
        Opprett_Where_utrykk_SP = Opprett_Where_utrykk_SP & Felt & Indikator & VerdiUtenIndikator
    End If
 
    ElseIf Indikator = "<>" Then
    Opprett_Where_utrykk_SP = Opprett_Where_utrykk_SP & Felt & Indikator & "'" & VerdiUtenIndikator & "'"
 
    Else 'Datofelt og nummer krever anderledes utrykk
    If Verdi = "Is null" Or Verdi = "Is not null" Then
        Opprett_Where_utrykk_SP = Opprett_Where_utrykk_SP & Felt & " " & Verdi
 
        ElseIf IsNumeric(Verdi) Or Not IsDate(Verdi) Then
        Opprett_Where_utrykk_SP = Opprett_Where_utrykk_SP & Felt & " like N'" & WildCardTegn & Verdi & WildCardTegn & "'"
 
        Else
        Opprett_Where_utrykk_SP = Opprett_Where_utrykk_SP & Felt & " like N'" & WildCardTegn & Verdi & WildCardTegn & "'"
    End If
End If

To adjust textboxes to listbox:

Function Still_inn_tekstbokser_Over_Liste(Skjema As String, Liste As String)
On Error Resume Next
Dim s As String
Dim words() As String
Dim Length As Long
Dim tbx As String
Dim TbxNr As Long
 
s = Forms(Skjema).Controls(Liste).ColumnWidths
s = Replace(s, ";", " ")
 
 
'Fjern alle tabstopp
words() = Split(s)
 
For TbxNr = 0 To 19
    Forms(Skjema).Controls("tbx " & TbxNr).TabStop = False
    Forms(Skjema).Controls("tbx " & TbxNr).TabIndex = TbxNr
    Forms(Skjema).Controls("tbx " & TbxNr).Width = 0
Next
 
'Still inn bredden til hver tekstboks utifra kollonnebredden på listen
Dim tempstr As String
For i = 0 To UBound(words)
    Forms(Skjema).Controls("tbx " & i).Width = words(i)
    Forms(Skjema).Controls("tbx " & i).TabStop = True
Next
 
 
'still inn plassering vertikalt i forhold til listen
Forms(Skjema).Controls("tbx 0").Left = Forms(Skjema).Controls(Liste).Left
 
For i = 0 To 19
    Forms(Skjema).Controls("tbx " & i).Top = Forms(Skjema).Controls(Liste).Top - Forms(Skjema).Controls("tbx " & i).Height
    Forms(Skjema).Controls("tbx " & i + 1).Left = Forms(Skjema).Controls("tbx " & i).Left + Forms(Skjema).Controls("tbx " & i).Width
Next
 
End Function

To populate listbox:

Function Populer_liste_SP(SQL As String, Skjema As String, Liste As String)
 
Dim Conn1 As New ADODB.Connection
Dim rst As New ADODB.Recordset
Dim cmd As New ADODB.Command
Dim sCreate As String
Dim sDrop As String
 
 
 
Dim OverSkrift As String
Dim InnHold As String
Dim Coll As Collection
Dim Tmpstr As String
Dim i As Long
Dim imax As Long
Dim FieldString As String
Dim Fieldstr As Long
'On Error Resume Next
'Max antall poster den skal hente
 
'Fjern gammelt listeinnhold
Forms(Skjema).Controls(Liste).RowSource = ""
 
 
'Koble til og lag stored procedure
 
 
sConnect = "driver={sql server};server=ServerName;Database=DBname;UID=username;PWD=password;"
 
sDrop = "if exists (select * from sysobjects where id = object_id('dbo.Sp_LokSumFlyttHistorikk') And sysstat=4 ) drop procedure dbo.Sp_LokSumFlyttHistorikk"
 
' Establish connection.
Set Conn1 = New ADODB.Connection
Conn1.ConnectionString = sConnect
Conn1.Open
 
cmd.ActiveConnection = Conn1
 
cmd.CommandType = adCmdText
cmd.CommandText = sDrop
cmd.Execute
 
 
sCreate = "create procedure sp_LokSumFlyttHistorikk " & _
"AS " & _
    SQL & _
    " Return"
cmd.CommandText = sCreate
cmd.Execute
 
cmd.CommandType = adCmdStoredProc
cmd.CommandText = "sp_LokSumFlyttHistorikk"
 
Set rst = cmd.Execute
 
    'Finn kolonneoverskrift
    For x = 1 To rst.Fields.Count
        If OverSkrift = "" Then
            OverSkrift = (rst.Fields(x - 1).Name)
            Else
            OverSkrift = OverSkrift & "; " & (rst.Fields(x - 1).Name)
        End If
    Next x
    'legg til kolonneoverskrift
        Forms(Skjema).Controls(Liste).AddItem OverSkrift
    'start å legg til innhold
    Do Until rst.EOF
    i = i + 1
 
    'imax antall rader i listen
        Tmpstr = ""
        For x = 1 To rst.Fields.Count
            If Not IsNull(rst.Fields(x - 1).Value) Then
                FieldString = rst.Fields(x - 1).Value
                Else
                FieldString = ""
            End If
            Do While InStr(1, FieldString, ";") <> 0
                FieldString = Left(FieldString, InStr(1, FieldString, ";") - 1) & " " & Mid(FieldString, InStr(1, FieldString, ";") + 1)
            Loop
 
 
            If Tmpstr = "" Then
                Tmpstr = FieldString
 
            Else
                Tmpstr = Tmpstr & "; " & FieldString
            End If
 
        Next x
 
        Fieldstr = Fieldstr + Len(Tmpstr)
        If Fieldstr > 32736 Then
            imax = 200
            GoTo exither
        End If
        Forms(Skjema).Controls(Liste).AddItem Tmpstr
    rst.MoveNext
    Loop
 
exither:
 
rst.Close
Set rst = Nothing
 
slutt:
'etikett overskrift
If imax = 200 Then
    Forms(Skjema).Controls("etk " & Liste).Caption = i & " (max) linjer i listen"
Else
    Forms(Skjema).Controls("etk " & Liste).Caption = i & " linjer i listen"
End If
 
 
On Error GoTo 0
 
 
End Function

All textboxes call this function to start all this:

Call Filtrer_Liste_SP("INFO Lokasjonstransaksjoner", "tbx 1", "liste over transaksjoner")

Which Calls this:

Sub Filtrer_Liste_SP(Skjema As String, tbxnavn As String, Listenavn As String, Optional HarTbx As String)
 
DoCmd.Hourglass True
 
Dim SqlString As String
Dim Wherestring As String
Dim i As Long
Dim SqlTilWhere As String
Dim SqlEtterWhere As String
 
If Not HarTbx = "nei" Then
    'bygg wherestring
    Do Until i = 20
        If Not IsNull(Forms(Skjema).Controls("tbx " & i)) Then
            Wherestring = Opprett_Where_utrykk_SP(Wherestring, Skjema, "tbx " & i, Forms(Skjema).Controls("tbx " & i), Listenavn)
        End If
        i = i + 1
    Loop
End If
 
'''''''''''''''''''''''''''''''''''''
'Velg hvilken populasjons-funksjon som skal kjøres
'''''''''''''''''''''''''''''''''''''
 
 
If Skjema = "INFO Lokasjonstransaksjoner" Then
    SqlTilWhere = "SELECT TOP 300 autonr, acd_user.[lok loksummer - flytthistorikk].Varenr, Varenavn, [behandlingstype], [boksid], [batch], [hendelse], [Antall tabletter], [Fra lokasjon], [Til lokasjon], [flyttet av], [flyttet tid] FROM acd_user.[lok loksummer - flytthistorikk] LEFT JOIN acd_user.[VARER Vareinformasjon] ON acd_user.[lok loksummer - flytthistorikk].Varenr=acd_user.[VARER Vareinformasjon].Varenr "
    SqlEtterWhere = " ORDER BY [autonr] desc;"
    Call Populer_liste_SP(SqlTilWhere & " " & Wherestring & " " & SqlEtterWhere, Skjema, Listenavn)
End If
 
 
 
DoCmd.Hourglass False
 
End Sub

I am not expecting anyone to understand this code, but it works real well for the users :=) Normally you just make a bound listboxes to the tables, but we have experienced that locking issues and server load is a challende when doing this. Therefore we made this and after that we have had none ODBC-timeouts when other users try to access or edit the same tables as show in listboxes.



Also: I didnt understand the "have a look at server optimisation hints noteably WITH (NOLOCK). " Maybe it is because my bad english ??


edit:removed the password and username from the code :P

[NeoPa]

MrDeej: edit:removed the password and username from the code :P

Always a good plan when posting publicly :D

Thanks for posting your solution. That's always good news :)