Discussion :

[John Mc Evee]

Bonjour au forum,

Je me permet de poster cette question car je suis en train d'écrire un module de construction de requête SQL afin d’interagir depuis Excel avec une base de donnée Access et je bloque sur la requête INSERT INTO.

Voici comment se décompose la logique de construction du module :

- Etape 1 : Je décris la structure de la requête via un fichier Texte

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
INSERT INTO @Table (@Field) 
VALUES @Value;

- Etape 2 : Je construis la requête SQL en tenant compte de la contrainte suivante : Les données sont sous forme de Collection de Dictionnaire. Pour cela j'utilise la fonction SQLInsert et FormatValue

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
'**************************************************************************************************
' NAME : SQLInsert (FUNCTION)
' INPUT : sPathFile (Strin
' OUTPUT : Request - String
' SOURCE : https://sql.sh/cours/insert-into
' STRUCTURE :
'   INSERT INTO client (prenom, nom, ville, age)
'   VALUES
'    ('Rébecca', 'Armand', 'Saint-Didier-des-Bois', 24);
'**************************************************************************************************
Public Function SQLInsert(sPathFile As String, sTable As String, sFields() As String, Values As Object) As String
 
    Const FUNCTION_NAME As String = "SQLInsert"
 
    On Error GoTo HANDLER_SQLINSERT
 
    Dim sRequest As String
    Dim sBuffer  As String
    Dim lBuffer  As Long
 
    sRequest = ReadFile(sPathFile)
 
    sRequest = Replace(sRequest, "@Table", sTable)
    sRequest = Replace(sRequest, "@Field", Join(sFields, ", "))
 
    For lBuffer = LBound(sFields, 1) To UBound(sFields, 1) Step 1
 
        If lBuffer = LBound(sFields, 1) Then sBuffer = sBuffer & "("
 
        If lBuffer <> UBound(sFields, 1) Then
            sBuffer = sBuffer & FormatValue(Values(sFields(lBuffer))) & ", "
        Else
            sBuffer = sBuffer & FormatValue(Values(sFields(lBuffer))) & ")"
        End If
 
    Next lBuffer
 
    sRequest = Replace(sRequest, "@Value", sBuffer)
 
    SQLInsert = sRequest
    Exit Function
 
HANDLER_SQLINSERT:
 
    SQLInsert = FUNCTION_NAME & " - Fail"
 
End Function

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
'**************************************************************************************************
' NAME : FormatValue (FUNCTION)
' INPUT : Value (Variant)
' OUTPUT : String
'**************************************************************************************************
Private Function FormatValue(Value As Variant) As String
 
    Select Case VarType(Value)
 
    Case vbString
 
        If InStr(Value, "'") = 0 Then
            FormatValue = "'" & CStr(Value) & "'"
        Else
            FormatValue = "''" & CStr(Value) & "''"
        End If
 
    Case vbLong, vbDouble, vbInteger
 
        FormatValue = Replace(CStr(Value), ",", ".")
 
    Case vbDate
 
        FormatValue = Format$(Value, "\#mm\/dd\/yyyy hh\:nn\:ss\#")
 
    Case Else
 
        FormatValue = vbNullString
 
    End Select
 
End Function

- Etape 3 : J'exécute la requête via la fonction AddNew

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
'**************************************************************************************************
' NAME : AddNew (FUNCTION)
' INPUT : sRequest (String), oConnect (ADODB.Connection), CursorType (Enum), LockType (Enum)
' OUTPUT : Request (Variant)
' SOURCE : https://ledzeppii.developpez.com/odbc-access/
'**************************************************************************************************
Public Function AddNew(sRequest As String, oConnect As ADODB.Connection, _
                       Optional CursorType As CursorTypeEnum = adOpenUnspecified, _
                       Optional LockType As LockTypeEnum = adLockUnspecified) As Variant
 
    Const FUNCTION_NAME As String = "Add New Request"
 
    On Error GoTo HANDLER_REQUEST
 
    ReDim TabError(0 To 0, 0 To 0) As Variant
 
    Dim Request As New ADODB.Recordset
    If InStr(sRequest, "SELECT") <> 0 Then
 
        With Request
 
            .Open sRequest, oConnect, CursorType, LockType
 
            If Not (.EOF And .BOF) Then AddNew = .GetRows
 
            .Close
 
        End With
 
        Set Request = Nothing
 
    Else
 
        oConnect.Execute sRequest
        TabError(0, 0) = FUNCTION_NAME & " - Good"
        AddNew = TabError
        Erase TabError
 
    End If
 
    Exit Function
 
HANDLER_REQUEST:
 
    Set Request = Nothing
    Debug.Print "---------------------------------------------"
    Debug.Print Err.Number & " - " & Err.Description
    TabError(0, 0) = FUNCTION_NAME & " - Fail"
    AddNew = TabError
    Erase TabError
 
End Function

- Voici comment j'initie, la requête et voici le résultat avec toujours la même erreur.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
Public Sub Main()
 
    Dim sRequest  As String
    Dim Result()  As Variant
 
    Debug.Print "******************************************"
    Debug.Print "MAIN TEST - SQL MODULE"
 
    ' *************** Test - CONNECTION ************************
    Dim Database  As ADODB.Connection
    This.Database = ThisWorkbook.Path & "\" & "Base.accdb"
    Set Database = ConnectToAccess(Provider(Access), This.Database)
 
    If Not Database Is Nothing Then
        Debug.Print "Test Connect to base Good"
    Else
        Debug.Print "Test Connect to base Fail"
        Exit Sub
    End If
 
    ' *************** Test - INSERT ************************
    Dim sTable As String
    This.PathFile = ThisWorkbook.Path & "\SQL\INSERT.txt"
    sTable = "price"
 
    ReDim sFields(0 To 5) As String
 
    sFields(0) = "fromtoken"
    sFields(1) = "totoken"
    sFields(2) = "opened"
    sFields(3) = "hight"
    sFields(4) = "low"
    sFields(5) = "closed"
 
    Dim Data   As New Dictionary
 
    Data.Add "fromtoken", "XVG"
    Data.Add "totoken", "BTC"
    Data.Add "opened", 0.0001
    Data.Add "hight", 0.00015
    Data.Add "low", 0.00009
    Data.Add "closed", 0.00012
 
    sRequest = SQLInsert(This.PathFile, sTable, sFields, Data)
    Result = AddNew(sRequest, Database)
 
    Debug.Print "----------------INSERT--------------------"
    Debug.Print sRequest & vbNewLine
    Debug.Print "Result : " & Result(0, 0)
    Debug.Print "End of test"
    Debug.Print "******************************************"
End sub

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
******************************************
MAIN TEST - SQL MODULE
Test Connect to base Good
---------------------------------------------
-2147217900 - Erreur de syntaxe dans l'instruction INSERT INTO.
----------------INSERT--------------------
INSERT INTO price (timestamp, fromtoken, totoken, opened, hight, low, closed) 
VALUES (100, 'XVG', 'BTC', 0.0001, 0.00015, 0.00009, 0.00012);
 
Result : Add New Request - Fail
End of test
******************************************

J'ai réussi à paramétrer le SELECT, WHERE, les JOIN, GROUPBY mais là je bloque. Si quelqu'un à une idée, je suis preneur.

Merci par avance.

A+

[marot_r]

Bonjour.

Le SQL de Access n'est pas très standard.

Voici comment j'ai pu le faire :

Code sql :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
INSERT INTO tblDestination ( ChampDestination )
SELECT UneValeur AS ChampDestination
FROM tblBidon;

Avec tblBidon qui ne contient qu'un seul enregistrement bidon.

A+

[John Mc Evee]

Bonsoir,

Je vous remercie pour l'approche et je n'ai pas trouvé une documentation très précise sur le sujet.

J'ai testé le code avec des données bidons et le message d'erreur suivant :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
 
    'INSERT INTO tblDestination ( ChampDestination )
    'SELECT UneValeur AS ChampDestination
    'FROM tblBidon;
    sRequest = "INSERT INTO @Table ( @Field )" & vbNewLine & "SELECT @Value AS @Field" _
               & vbNewLine & "FROM @TabValue;"
 
    sRequest = Replace(sRequest, "@Table", "price")
    sRequest = Replace(sRequest, "@Value", "0.0006")
    sRequest = Replace(sRequest, "@Field", "low")
    sRequest = Replace(sRequest, "@TabValue", "0.0006")
 
    Result = AddNew(sRequest, Database)

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

-2147467259 - Fichier «*C:\Users\John Mc Eevee\Documents\0.mdb*» introuvable

J'ai pensé que cela pouvais venir de la connexion en elle même. J'utilise celle-ci pour me retourner la connection.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

sConnect = "Provider=@Provider;Data Source=@Database;Jet OLEDB:Database Password=@Password;"

Quelle connexion utilisez-vous ?

A+

[John Mc Evee]

Re-bonsoir,

Rien ne vaut un peu de persévérance et de méthode (J'ai passer en dur ma requête dans Access et j'ai trouvé les problèmes)

J'ai un bug sur un des champs et il ne veut pas me l'insérer (j'ai pas réglé le problème mais je pense que cela vient d'une erreur de type)

En excluant ce champ, l'insertion c'est correctement faite.

Cependant je ne peux insérer qu'un seul dictionnaire à la fois. Je ferai des tests plus poussé pour voir si le temps est important ou trouver un moyen d'envoyer toutes les données en une seule requête.

Voici le résultat du test. Je ne reposte pas le code car il n'a pas été modifié.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
MAIN TEST - SQL MODULE
Test Connect to base Good
----------------INSERT--------------------
INSERT INTO price (fromtoken, totoken, opened, hight, low, closed) 
VALUES ('AAA', 'BTC', 0.0001, 0.00015, 0.00009, 0.00012);
 
Result : Add New Request - Good
End of test

Je vous remercie et A+