SIMPLIFIER LES REQUÊTES SQL SOUS ADO / ADODB

Option Explicit

'-------------------------------
'Auteur  : Skrol 29
'Email   : skrol29@freesurf.fr
'Web     : www.skrol29.com
'Version : 1.01
'-------------------------------

'Voici un ensemble de fonctions simples et pratiques pour travailler
' sur base de données avec ADODB sous Visual Basic ou Access.

'Description des fonctions :
'm_Sql_OuvreConnexion() : ouvre un nouvelle connexion et retourne cette connexion
'm_Sql_Éval()           : retourne la valeur du premier champ de la première ligne de l'instruction SQL
'm_Sql_Exécute()        : exécute l'instruction SQL et retourne le nombre de lignes affectées
'm_Sql_AjouteEnreg()    : ajoute un enregistrement à une table
'm_Sql_OuvreRsL()       : retourne un nouveau RecordSet en mode lecture seule    sur une instruction SQL
'm_Sql_OuvreRsM         : retourne un nouveau RecordSet en mode lecture/écriture sur une instruction SQL
'm_Sql_Montage()        : fusionne une expression SQL avec des valeurs

'La variable publique 'g_Cnx' :
'La variable publique g_Cnx représente la connexion à la base de données.
'Toutes les fonctions s'appuient sur cette connexion et supposent qu'elle est ouverte.
'Il faudra donc, à un moment donné dans votre code, ouvrir la connexion, par exemple à l'aide de la fonction m_Sql_OuvreConnexion().

'Sous Access 2000 et 2002 :
'L'application Access fourni déjà une variable publique qui représente la connexion
' ouverte sur la base de données en cours. La variable 'g_Cnx' devient donc
' inutile et doit être remplacée dans ce code par l'expression 'CurrentProject.Connection'.

'Utilisation de la fusion dans les fonctions :
'La plupart des fonctions ci-dessous permettent un codage rapide et rigoureux
' grâce à leur possibilité de fusionner l'instruction SQL, évitant ainsi aux développeurs
' de monter l'instruction SQL par concaténation de chaîne.
'Comment ça marche ? C'est tout simple.
'Au lieu de coder :
'  m_Sql_Exécute "DELETE Matable WHERE (Nature=" & xNature & ") AND (Ville='" & xVille "')"
'Vous pouvez coder :
'  m_Sql_Exécute "DELETE Matable WHERE (Nature=%1%) AND (Ville='%2%')",xNature,xVille
'
'C'est carrément plus claire non ?
'Attention à ne pas oublier les délimiteurs dans vos instructions SQL.
'Il vous faudra aussi malheureusement reformater vos dates avant de les passer en paramètre
' mais ça c'est toujours un problème avec le langage SQL.


Public g_Cnx As New ADODB.Connection

Public Function m_Sql_Exécute(SqlStr As String, ParamArray PrmLst() As Variant) As Long
'*** Cette fonction fusionne l'instruction SqlStr et les valeurs PrmLst() comme décrite plus haut.
'Execute le SQL et retourne le nombre d'enregistrement affecté.

  Dim i As Long
  Dim x As String
  
  Dim Nbr As Long
  
  'Fusion entre la chaîne et les paramètres
  x = SqlStr
  For i = 0 To UBound(PrmLst)
    x = Replace(x, "%" & (i + 1) & "%", "" & PrmLst(i))
  Next i
  
  g_Cnx.Execute x, Nbr
  
  m_Sql_Exécute = Nbr
  
End Function

Public Function m_Sql_Éval(SqlStr As String, ParamArray PrmLst() As Variant) As Variant
'*** Cette fonction fusionne l'instruction SqlStr et les valeurs PrmLst() comme décrite plus haut.
'Retourne la valeur du premier champ retourné par l'instrcution SQL renseignée.
'Il peut s'agir une phrase SELECT ou d'une procédure stockée.
'exemple : m_Sql_Éval("SELECT COUNT(*) FROM Matable WHERE (Age>%1%) AND (Ville='%2%')",30,"TOULOUSE")

  Dim i As Long
  Dim x As String
  
  Dim Rs As New ADODB.Recordset
  Dim Cmd As New ADODB.Command
  
  'Fusion entre la chaîne et les paramètres
  x = SqlStr
  For i = 0 To UBound(PrmLst)
    x = Replace(x, "%" & (i + 1) & "%", "" & PrmLst(i))
  Next i
  
  Rs.Open x, g_Cnx, adOpenStatic, adLockReadOnly
  p_TrouveDernierRs Rs
  
  If Rs.EOF Then
    m_Sql_Éval = Null
  Else
    m_Sql_Éval = Rs.Fields(0).Value
  End If
  Rs.Close
  
End Function

Public Sub m_Sql_AjouteEnreg(Table As String, ParamArray FieldsAndValues() As Variant)
'Ajoute un nouvel enreg dans la table avec les données spécifée.
'Deux syntaxes possibles :
'Syntaxe 1 : m_Sql_AjouteEnreg "MaTable","champs1",val1,"champ2",val2,"champ3",val3
'Syntaxe 2 : m_Sql_AjouteEnreg "MaTable","champs1,champ2,champ3",val1,val2,val3

  Dim i As Long
  Dim Rs As New ADODB.Recordset
  
  Dim Syntaxe As Integer
  
  'On regard quelle syntaxe est utilisée
  Syntaxe = 1
  If UBound(FieldsAndValues) >= 0 Then
    If InStr("" & FieldsAndValues(0), ",") > 0 Then
      Syntaxe = 2
    End If
  End If
  
  With Rs
    
    'ajoute l'enreg
    If Syntaxe = 1 Then
      .Open "SELECT TOP 0 * FROM " & Table, g_Cnx, adOpenKeyset, adLockOptimistic
      i = 0
      .AddNew
      Do Until i > UBound(FieldsAndValues)
        .Fields(FieldsAndValues(i)).Value = FieldsAndValues(i + 1)
        i = i + 2
      Loop
      .Update
      .Close
    Else
      .Open "SELECT TOP 0 " & FieldsAndValues(0) & " FROM " & Table, g_Cnx, adOpenKeyset, adLockOptimistic
      .AddNew
      For i = 1 To UBound(FieldsAndValues)
        .Fields(i - 1).Value = FieldsAndValues(i)
      Next i
      .Update
      .Close
    End If
    
  End With
  
End Sub

Public Function m_Sql_OuvreRsL(SqlStr As String, ParamArray PrmLst() As Variant) As ADODB.Recordset
'*** Cette fonction fusionne l'instruction SqlStr et les valeurs PrmLst() comme décrite plus haut.
'Retourne un nouveau Recordset ouvert en mode lecture seule.

  Dim i  As Long
  Dim x  As String
  
  Dim Rs As New ADODB.Recordset
  
  'Fusion entre la chaîne et les paramètres
  x = SqlStr
  For i = 0 To UBound(PrmLst)
    x = Replace(x, "%" & (i + 1) & "%", "" & PrmLst(i))
  Next i
  
  Rs.Open x, g_Cnx, adOpenKeyset, adLockReadOnly
  p_TrouveDernierRs Rs
  
  Set m_Sql_OuvreRsL = Rs
  
End Function

Public Function m_Sql_OuvreRsM(SqlStr As String, ParamArray PrmLst() As Variant) As ADODB.Recordset
'*** Cette fonction fusionne l'instruction SqlStr et les valeurs PrmLst() comme décrite plus haut.
'Retourne un nouveau Recordset ouvert en mode lecture/modif.

  Dim i  As Long
  Dim x  As String
  
  Dim Rs As New ADODB.Recordset
  
  'Fusion entre la chaîne et les paramètres
  x = SqlStr
  For i = 0 To UBound(PrmLst)
    x = Replace(x, "%" & (i + 1) & "%", "" & PrmLst(i))
  Next i
  
  Rs.Open x, g_Cnx, adOpenKeyset, adLockOptimistic
  p_TrouveDernierRs Rs
  
  Set m_Sql_OuvreRsM = Rs
  
End Function

Public Function m_Sql_OuvreConnexion(Srv As String, Db As String, TrustedConn As Boolean, Optional Uid As String, Optional Pwd As String) As ADODB.Connection
'Ouvre un nouvelle connexion et retourne la connexion ouverte.
'Testé uniquement avec SQL-Server, merci de me dire si ça fonctionne aussi sous Oracle.
'NB : la paramètre TrustedConn doit être à True pour indiquer une connexion approuvée par le Login NT.

  Dim Cnx As New ADODB.Connection

  Dim x As String
  
  x = ""
  x = x & "PROVIDER=SQLOLEDB.1;"
  x = x & "PERSIST SECURITY INFO=FALSE;"
  x = x & "APPLICATION NAME=" & App.EXEName & ";"
  x = x & "DATA SOURCE=" & Srv & ";"
  x = x & "INITIAL CATALOG=" & Db & ";"
  If TrustedConn = True Then
    x = x & "INTEGRATED SECURITY=SSPI"
    Cnx.Open x
  Else
    Cnx.Open x, Uid, Pwd
  End If

  Set m_Sql_OuvreConnexion = Cnx

End Function

Private Sub p_TrouveDernierRs(Rs As ADODB.Recordset)
'Il arrive parfois que des procédures sockées retourne plusieurs jeux d'enregistrements.
'Quand cela arrive, il faut récupérer le premier Recorset utilisable.
'NB : il très important de ne pas utiliser l'instruction With dans cette procédure car
' la varibale Rs est ré-assignée.

  Do Until Rs.State <> 0
    Set Rs = Rs.NextRecordset
  Loop

End Sub

Public Function m_Sql_Montage(SqlStr As String, ParamArray PrmLst() As Variant) As String
'*** Cette fonction fusionne l'instruction SqlStr et les valeurs PrmLst() comme décrite plus haut.
'Cette fonction permet simplement de monter une chaîne texte SQL en fusionnant le modème avec les paramètres
  
  Dim i  As Long
  Dim x  As String
  
  'Merging SqlStr and Parateters
  x = SqlStr
  For i = 0 To UBound(PrmLst)
    x = Replace(x, "%" & (i + 1) & "%", "" & PrmLst(i))
  Next i
  
  m_Sql_Montage = x
  
End Function