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+