[VBA Excel + SQL] Modifier un enregistrement

Le 27/07/2022 à 12:38

Bonjour le forum

Mon problème est "simple", je cherche à modifier les données dans un fichier Excel servant de base de données. Dans le code ci-dessous, la partie servant à ajouter un enregistrement fonctionne parfaitement mais je galère sur la partie liée à la modification d'un enregistrement. Je découvre les requêtes SQL donc je ne maitrise pas assez ce langage pour me dépanner tout seul (même après de très longue heure à éplucher des forums ).

Pour expliquer ma logique : dans l'appel de la procédure d'ajout/modification de ma base de données, j'ai la variable LineToEdit qui me permet (dans le cas d'une modification d'enregistrement) de savoir sur quelle ligne de la base de données je dois apporter les modifications. Dans la variable DataImport, est stocké l'ensemble des données à mettre sur la ligne LineToEdit. Vous verrez, les données sont toutes retravaillées afin de correspondre à la syntaxe propre à une requête SQL.

J'ai donc ma requête SQL : RequêteSQL = "SELECT * FROM [" & DataBaseName & "$" & Plage & "]" et mes données DataImport(). Si je devais schématiser ce que je cherche à faire serai quelque chose du style RequêteSQL = DataImport.

J'espère avoir été clair, par avance, merci de l'aide apporté au sujet ! 

Private Function DatabaseEditor_SQL(DataImport() As Variant, DataBase As String, DataBaseName As String, TypeEdit As Boolean, Optional LineToEdit As Long) As Boolean
Dim NomFichier As String, RequêteSQL As String, Val As String, Plage As String
Dim i As Long, j As Long, Cpt As Long, FormatVal As Long
Dim EtatBDD As Integer
Dim TblFormat() As Variant
Dim Cn As ADODB.Connection
Dim Cd As ADODB.Command
Dim Rst As ADODB.Recordset
Dim Fld As ADODB.Field

    'On Error GoTo ErrSQL
    'TypeEdit permet de dire si l'étiteur doit ajouter une nouvelle entrée ou en modifier une
    'TypeEdit = 0 : écriture (pour ajouter un enregistrement)
    'TypeEdit = 1 : modification (pour modifier un enregistrement)
    'Vérifier que la base de données est libre en lecture/écriture
    DatabaseEditor_SQL = False
    If TypeEdit = False And LineToEdit = 0 Then MsgBox "Pas de référence pour éditer la base de données.", vbCritical: Exit Function
    If TypeEdit = False And LineToEdit = 1 Then MsgBox "La ligne à éditer dans la base de données ne peut pas être la première ligne.", vbCritical: Exit Function
    NomFichier = Split(DataBase, "\")(UBound(Split(DataBase, "\")))
    EtatBDD = FichierLibre(DataBase)
    If EtatBDD = -1 Then MsgBox "La base de données « " & NomFichier & "' » est ouverte sur votre PC. Attention la fenêtre est masquée, vous devez la fermer avant de poursuivre. Enregistrement impossible.", vbCritical: Exit Function
    If EtatBDD = 1 Then MsgBox "La base de données « " & NomFichier & "' » est ouverte sur votre PC, vous devez la fermer avant de poursuivre. Enregistrement impossible.", vbCritical: Exit Function
    If EtatBDD = 2 Then MsgBox "Une connexion ou une instance est déjà en cours sur la base de donnée « " & NomFichier & "' ». Enregistrement impossible pour le moment, veuillez réessayer dans quelques instants.", vbCritical: Exit Function

    'Connexion à la base de données
    Set Cn = New ADODB.Connection
    Cn.Provider = "Microsoft.Jet.OLEDB.4.0"
    Cn.ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & DataBase & ";Extended Properties=""Excel 12.0;HDR=YES;"""
    Cn.Open

    'S'assurer que le nombre de donnée à importer correspond bien au nombre de colonne dans la base de données
    RequêteSQL = "SELECT * FROM [" & DataBaseName & "$]"
    Set Rst = New ADODB.Recordset
    Set Rst = Cn.Execute(RequêteSQL)
    If Rst.Fields.Count <> UBound(DataImport) + 1 Then
        MsgBox "Le nombre de données à importer ne correspond pas au nombre de colonne dans la base de données.", vbCritical
        Cn.Close
        Set Cn = Nothing
        Exit Function
    End If

    'Récupération des formats de colonne pour préparer la rédaction de la requête SQL
    ReDim TblFormat(1 To Rst.Fields.Count)
    Cpt = 0
    For Each Fld In Rst.Fields: Cpt = Cpt + 1: TblFormat(Cpt) = Fld.Type: Next Fld
    Val = "": FormatVal = 0: RequêteSQL = ""
    For i = LBound(TblFormat) To UBound(TblFormat)
        FormatVal = TblFormat(i)
        DataImport(i - 1) = Replace(DataImport(i - 1), """", """""") 'Modification des guillemets simple en double guillemets pour ne pas avoir d'erreur dans la requête SQl
        If DataImport(i - 1) = "" Then
            Val = "Null" 'Mise à l'état "Null" pour les valeur vide
        Else
            Select Case FormatVal
                Case 14, 131, 5, 3, 2 'Nombre
                    Val = DataImport(i - 1)
                Case 7, 133, 134, 135 'Date/heure
                    Val = "#" & Month(CDate(DataImport(i - 1))) & "/" & Day(CDate(DataImport(i - 1))) & "/" & Year(CDate(DataImport(i - 1))) & "#" 'Correction de la date (format US obligatoire)
                Case Else 'Texte et autres formats
                    Val = """" & DataImport(i - 1) & """" 'Ajout des guillemets pour les valeurs texte
            End Select
        End If
        If i > LBound(TblFormat) Then Val = ", " & Val
        RequêteSQL = RequêteSQL & Val

        'Execution de la requête SQl
        If i = UBound(TblFormat) Then
            If TypeEdit = True Then 'requête pour écrire (ajouter un enregistrement)
                RequêteSQL = "INSERT INTO [" & DataBaseName & "$] VALUES (" & RequêteSQL & ")"
                'Debug.Print RequêteSQL
                Cn.Execute RequêteSQL
            Else 'requête pour modifier (modifier un enregistrement)
                Plage = Replace(Range(Cells(LineToEdit, 1), Cells(LineToEdit, Cpt)).Address, "$", "")
                RequêteSQL = "SELECT * FROM [" & DataBaseName & "$" & Plage & "]"
                'Debug.Print RequêteSQL
                Set Cd = New ADODB.Command
                Cd.ActiveConnection = Cn
                Cd.CommandText = RequêteSQL
                Set Rst = New ADODB.Recordset
                Rst.Open Cd, , adOpenKeyset, adLockOptimistic
                For j = LBound(DataImport) To UBound(DataImport): Rst(j).Value = DataImport(j): Next j
                Rst.Update
            End If
        End If
    Next i
    Cn.Close
    Set Cn = Nothing
    Set Cn = Nothing
    Set Cd = Nothing
    Set Rst = Nothing
    DatabaseEditor_SQL = True

Exit Function
ErrSQL:
DatabaseEditor_SQL = False
If Not Cn Is Nothing Then Cn.Close: Set Cn = Nothing
End Function
Function FichierLibre(Chemin As String) As Long
Dim Classeur As Workbook
Dim NomFichier As String
Dim NumeroFichier As Long, NumeroErreur As Long
Dim i As Long

'    -1 : le fichier est ouvert sur le poste de travail mais fenêtre masquée
'     0 : le fichier est libre
'     1 : le fichier est ouvert sur le poste de travail
'     2 : le fichier est ouvert par un autre utilisateur ou une instance

    Set Classeur = Nothing
    NomFichier = Split(Chemin, "\")(UBound(Split(Chemin, "\")))
    For i = 1 To Application.Windows.Count
        If Application.Windows(i).Caption = NomFichier Then
            Set Classeur = Application.Workbooks(Application.Windows(i).Caption)
            If Application.Windows(i).Visible = False And Classeur.ReadOnly = True Then Classeur.Close savechanges:=False: Exit For
            If Application.Windows(i).Visible = False And Classeur.ReadOnly = False Then FichierLibre = -1: Exit Function
            If Application.Windows(i).Visible = True And Classeur.ReadOnly = True Then Classeur.Close savechanges:=False: Exit For
            If Application.Windows(i).Visible = True And Classeur.ReadOnly = False Then FichierLibre = 1: Exit Function
        End If
    Next i

    On Error Resume Next
    NumeroFichier = FreeFile()
    Open Chemin For Input Lock Read As #NumeroFichier
    Close NumeroFichier
    NumeroErreur = Err
    On Error GoTo 0
    Select Case NumeroErreur
    Case 0:    FichierLibre = 0
    Case 70:   FichierLibre = 2
    Case Else: Error NumeroErreur
    End Select
End Function

Dossier pour tests :

20sql.zip (37.95 Ko)
Le 27/07/2022 à 14:46

J'ai trouvé

Voici la solution qui fonctionne pour éditer une base de données quand on connait le numéro de ligne à éditer (ou l'enregistrement) :

RequêteSQL = "SELECT * FROM [" & DataBaseName & "$]"
Set Cd = New ADODB.Command
Cd.ActiveConnection = Cn
Cd.CommandText = RequêteSQL
Set Rst = New ADODB.Recordset
Rst.Open Cd, , adOpenKeyset, adLockOptimistic
Rst.Move (LineToEdit)
For j = LBound(DataImport) To UBound(DataImport): Rst(j).Value = DataImport(j): Next j
Rst.Update
Le 27/07/2022 à 16:07

Pour tout ceux qui passe par ici et qui cherche un code permettant de lire, écrire et modifier un fichier Excel fermé, voici mon code.

Explication : Appel de la procédure

DataImport doit être un tableau de type Array à une dimension contenant les données à ajouter ou à modifier dans la base de données.

Exemple : DataImport = Array ("12/08/2022" , "Dupon" , "Axel" , "" , "43")

DataBase est le lien menant à la base de données ou fichier Excel servant de base de données.

Exemple : DataBase = "C:\DataBusiness\Axel\Desktop\Mes dossiers\MaBdd.xlsx"

DataBaseName est le nom de la feuille contenant la base de données dans le fichier DataImport

Exemple DataBaseName = "BDD"

Si vous voulez ajouter ces données à la base de données, mettez TypeEdit à l'état True si vous voulez mettre à jour un enregistrement passez TypeEdit à l'étatFalse et spécifiez la ligne dans la base de données où se trouve l'enregistrement en question avec la variable LineToEdit

Pour info, c'est la première fois que je manipule le langage SQL, ce n'est peut être pas ce qu'il y a de plus optimisé mais chez moi ce code fonctionne

J'espère rendre ce poste utile !

Private Function DatabaseEditor_SQL(DataImport() As Variant, DataBase As String, DataBaseName As String, TypeEdit As Boolean, Optional LineToEdit As Long) As Boolean
Dim NomFichier As String, RequêteSQL As String
Dim Val As Variant
Dim i As Long, j As Long, Cpt As Long, FormatVal As Long
Dim EtatBDD As Integer
Dim TblFormat() As Variant
Dim Cn As ADODB.Connection
Dim Cd As ADODB.Command
Dim Rst As ADODB.Recordset
Dim Fld As ADODB.Field

    'On Error GoTo ErrSQL
    'TypeEdit permet de dire si l'étiteur doit ajouter une nouvelle entrée ou en modifier une
    'TypeEdit = True : écriture (pour ajouter un enregistrement)
    'TypeEdit = False : modification (pour modifier un enregistrement)

    DatabaseEditor_SQL = False
    If TypeEdit = False And LineToEdit = 0 Then MsgBox "Pas de référence pour éditer la base de données.", vbCritical: Exit Function
    If TypeEdit = False And LineToEdit = 1 Then MsgBox "La ligne à éditer dans la base de données ne peut pas être la première ligne.", vbCritical: Exit Function
    If TypeEdit = False Then LineToEdit = LineToEdit - 1
    NomFichier = Split(DataBase, "\")(UBound(Split(DataBase, "\")))

    'Vérifier que le fichier est accessible
    If VérifierChemin(DataBase) = False Then MsgBox "Impossible de trouver « " & NomFichier & " » dans le dossier « " & Left(DataBase, Len(DataBase) - Len(Split(DataBase, "\")(UBound(Split(DataBase, "\"))))) & " ». Opération annulée.", vbCritical: Exit Function

    'Vérifier que la base de données est libre en lecture/écriture
    EtatBDD = FichierLibre(DataBase)
    If EtatBDD = -1 Then MsgBox "La base de données « " & NomFichier & " » est ouverte sur votre PC. Attention la fenêtre est masquée, vous devez la fermer avant de poursuivre. Enregistrement impossible.", vbCritical: Exit Function
    If EtatBDD = 1 Then MsgBox "La base de données « " & NomFichier & " » est ouverte sur votre PC, vous devez la fermer avant de poursuivre. Enregistrement impossible.", vbCritical: Exit Function
    If EtatBDD = 2 Then MsgBox "Une connexion ou une instance est déjà en cours sur la base de donnée « " & NomFichier & "' ». Enregistrement impossible pour le moment, veuillez réessayer dans quelques instants.", vbCritical: Exit Function

    'Connexion à la base de données
    Set Cn = New ADODB.Connection
    Cn.Provider = "Microsoft.Jet.OLEDB.4.0"
    Cn.ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & DataBase & ";Extended Properties=""Excel 12.0;HDR=YES;"""
    Cn.Open

    'S'assurer que le nombre de donnée à importer correspond bien au nombre de colonne dans la base de données
    RequêteSQL = "SELECT * FROM [" & DataBaseName & "$]"
    Set Rst = New ADODB.Recordset
    Set Rst = Cn.Execute(RequêteSQL)
    If Rst.Fields.Count <> UBound(DataImport) + 1 Then
        MsgBox "Le nombre de données à importer ne correspond pas au nombre de colonne dans la base de données.", vbCritical
        Cn.Close
        Set Cn = Nothing
        Exit Function
    End If

    'Récupération des formats de colonne pour préparer la rédaction de la requête SQL
    ReDim TblFormat(1 To Rst.Fields.Count)
    Cpt = 0
    For Each Fld In Rst.Fields: Cpt = Cpt + 1: TblFormat(Cpt) = Fld.Type: Next Fld
    Val = "": FormatVal = 0: RequêteSQL = ""
    For i = LBound(TblFormat) To UBound(TblFormat)
        FormatVal = TblFormat(i)
        'DataImport(i - 1) = Replace(DataImport(i - 1), """", """""") 'Modification des guillemets simple en double guillemets pour ne pas avoir d'erreur dans la requête SQl
        If DataImport(i - 1) = "" Then
            Val = "Null" 'Mise à l'état "Null" pour les valeur vide
        Else
            Select Case FormatVal
                Case 14, 131, 5, 3, 2 'Nombre
                    Val = DataImport(i - 1)
                Case 7, 133, 134, 135 'Date/heure
                    Val = "#" & Month(CDate(DataImport(i - 1))) & "/" & Day(CDate(DataImport(i - 1))) & "/" & Year(CDate(DataImport(i - 1))) & "#" 'Correction de la date (format US obligatoire)
                Case Else 'Texte et autres formats
                    Val = Replace(DataImport(i - 1), """", """""")
                    Val = """" & Val & """" 'Ajout des guillemets pour les valeurs texte
            End Select
        End If
        If i > LBound(TblFormat) Then Val = ", " & Val
        RequêteSQL = RequêteSQL & Val

        'Execution de la requête SQl
        If i = UBound(TblFormat) Then
            If TypeEdit = True Then 'requête pour écrire (ajouter un enregistrement)
                RequêteSQL = "INSERT INTO [" & DataBaseName & "$] VALUES (" & RequêteSQL & ")"
                'Debug.Print RequêteSQL
                Cn.Execute RequêteSQL
            Else 'requête pour modifier (modifier un enregistrement)
                RequêteSQL = "SELECT * FROM [" & DataBaseName & "$]"
                Set Cd = New ADODB.Command
                Cd.ActiveConnection = Cn
                Cd.CommandText = RequêteSQL
                Set Rst = New ADODB.Recordset
                Rst.Open Cd, , adOpenKeyset, adLockOptimistic
                If LineToEdit = 1 Then
                    Rst.MoveFirst
                ElseIf LineToEdit = Rst.RecordCount Then
                    Rst.MoveLast
                Else
                    Rst.Move (LineToEdit - 2)
                End If
                For j = LBound(TblFormat) To UBound(TblFormat)
                    FormatVal = TblFormat(j)
                    If DataImport(j - 1) = "" Then
                        Val = Null 'Mise à l'état "Null" pour les valeur vide
                    Else
                        Select Case FormatVal
                            Case 14, 131, 5, 3, 2: Val = CDbl(DataImport(j - 1))
                            Case 7, 133, 134, 135: Val = CDate(DataImport(j - 1))
                            Case Else: Val = CStr(DataImport(j - 1))
                        End Select
                    End If
                    Rst(j - 1).Value = Val
                Next j
                Rst.Update
            End If
        End If
    Next i
    Cn.Close
    Set Cn = Nothing
    Set Cd = Nothing
    Set Rst = Nothing
    DatabaseEditor_SQL = True

Exit Function
ErrSQL:
DatabaseEditor_SQL = False
If Not Cn Is Nothing Then Cn.Close: Set Cn = Nothing
End Function
Le 27/07/2022 à 21:31

Hello,

Bien cette fonction

Un chouïa longuée mais j'apprécie

++

Rechercher des sujets similaires à "vba sql modifier enregistrement"