Ecrire et Modifier dans un classeur .xlsm fermé

**Naru31** · 11/03/2016, 20h12

Bonjour,

J'ai lu le tuto de SilkyRoad sur "Lire et écrire dans les classeurs Excel fermés".

Pour vous donner ma situation :
-J'ai un 1er classeur en .xlsm me servant de base de données, que j'ai nommé "BDD TMT.xlsm" et dont mes données se trouvent sur la première feuille nommé "Topics".
-J'ai un 2ème classeur en .xlsm me servant de visionneuse, que j'ai nommé "Topic Management Tool.xlsm" et dont les données de la feuille "Topics" du classeur fermé "BDD TMT.xlsm" sont récupérés dans la 1ère feuille nommé aussi "Topics" via la macro suivante :

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
Sub Import_Data()
    Dim Cn As ADODB.Connection
    Dim Fichier As String
    Dim NomFeuille As String, texte_SQL As String
    Dim Rst As ADODB.Recordset
 
    'Définit le classeur fermé servant de base de données
    Fichier = "C:\BDD TMT.xlsm"
    'Nom de la feuille dans le classeur fermé
    NomFeuille = "Topics"
 
    Set Cn = New ADODB.Connection
 
    '--- Connection ---
    With Cn
        .Provider = "Microsoft.Jet.OLEDB.4.0"
        .ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" _
            & Fichier & ";Extended Properties=""Excel 12.0;HDR=YES;"""
        .Open
    End With
    '-----------------
 
    'Définit la requête.
    texte_SQL = "SELECT * FROM [Topics$]"
 
    Set Rst = New ADODB.Recordset
    Set Rst = Cn.Execute(texte_SQL)
 
    'Ecrit le résultat de la requête dans la cellule A2
    Range("A2").CopyFromRecordset Rst
 
    '--- Fermeture connexion ---
    Cn.Close
    Set Cn = Nothing
 
End Sub

Donc j'arrive bien à récupérer les données de mon classeur fermé "BDD TMT.xlsm" mais je n'arrive pas à comprendre comment je peux modifier les données et écrire des nouvelles données (nouvelles lignes) dans mon classeur fermé "BDD TMT.xlsm" à partir de mon classeur ouvert "Topic Management Tool.xlsm".
Bref je souhaiterai renvoyez toute mes modifications et mes nouvelles données de mon classeur ouvert "Topic Management Tool.xlsm" dans mon classeur fermé "BDD TMT.xlsm" et je n'arrive pas à comprendre et appliquer la partie IV-B. Ajouter un enregistrement et IV-C. Modifier les enregistrements du tuto de SilkyRoad.

Est-ce que quelqu'un peut m'aider, svp ?

Merci d'avance

Invité · 11/03/2016, 20h26

Bonsoir,

Code requête ajouter :

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

1
2
3
 
SQL = "insert into [Topics$] [champ1],[camp2] value ('toto',1.1234);"
Cn.execute sql

Code mise a jour :

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

1
2
3
 
SQL = "update [Topics$] set [champ1]='titi',[champ2]=6632 where identifiant=123;"
Ne.execute sql

**Naru31** · 11/03/2016, 22h52

Merci rdurupt pour ta réponse mais :

>Pour la requête d'ajout, cela me met une erreur :

Erreur d'exécution '-2147217900 (80040e14)':
Erreur de syntaxe dans l'instruction INSERT INTO

Voici le code et là ou ça bloque :

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
Sub add_Data()
     Dim Cn As ADODB.Connection
     Dim Fichier As String
     Dim texte_SQL As String
     Dim Rst As ADODB.Recordset
    
     'Définit le classeur fermé servant de base de données
     Fichier = "C:\BDD TMT.xlsm"
    
     Set Cn = New ADODB.Connection
    
     '--- Connection ---
     With Cn
        .Provider = "Microsoft.Jet.OLEDB.4.0"
        .ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" _
        & Fichier & ";Extended Properties=""Excel 12.0;HDR=YES;"""
        .Open
     End With
     '-----------------
    
    texte_SQL = "insert into [Topics$] [champ1],[camp2] value ('toto',1.1234);"
    
    Set Rst = New ADODB.Recordset
    Set Rst = Cn.Execute(texte_SQL)
    
     '--- Fermeture connexion ---
     Cn.Close
     Set Cn = Nothing

 End Sub

>Et pour la requête de mise à jour, cela me met une erreur :

Erreur d'exécution '-2147217904 (80040e10)':
Aucune valeur donnée pour un ou plusieurs des paramètres requis.

Voici le code et là ou ça bloque (encore...) :

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
Sub update_Data()
     Dim Cn As ADODB.Connection
     Dim Fichier As String
     Dim texte_SQL As String
     Dim Rst As ADODB.Recordset
    
     'Définit le classeur fermé servant de base de données
     Fichier = "C:\BDD TMT.xlsm"
     'Nom de la feuille dans le classeur fermé
     NomFeuille = "Topics"
    
     Set Cn = New ADODB.Connection
    
     '--- Connection ---
     With Cn
        .Provider = "Microsoft.Jet.OLEDB.4.0"
        .ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" _
        & Fichier & ";Extended Properties=""Excel 12.0;HDR=YES;"""
        .Open
     End With
     '-----------------
    
    texte_SQL = "update [Topics$] set [champ1]='titi',[champ2]=6632 where identifiant=123;"
    
    Set Rst = New ADODB.Recordset
    Set Rst = Cn.Execute(texte_SQL)
    
     '--- Fermeture connexion ---
     Cn.Close
     Set Cn = Nothing

 End Sub

Qu'est qui ne convient pas dans ce code ?

Invité · 12/03/2016, 01h11

J'ai lus plusieurs postes qui font allusion au tutoriel de SilkyRoad!

Je n'ai jamais pris le temps d'y getter un oeil, mais j'imagine qu'il doit être complet!

Mais malheureusement pour lui les gens ne s'arrête qua ce qui les intéressent et ne prennent pas la peine de le lire jusqu'au bout!

On va tenter de combler ces lacunes!

L'instruction HDR=YES dans la chêne de connexion veux dire que la première ligne de ton tableau Excel est le nom de colonnes.

Dans mon exemple champ1,champ2,identifiant, mais ça pourrait être date facture,numéro facture, libellé facture.

HDR=no veut dire que la première ligne n'est pas le titre des colonnes,'donc les champs par défaut sont respectivement pour les colonnes A,B,C F1,F2,F3.

Maintenant si tu reprends les deux requêtes et que tu les adapte a ce que je viens de dire tous prend son sans!

**Naru31** · 12/03/2016, 02h21

Merci encore de ta réponse.

Je vais tester cela et réfléchir à mon code en prenant un peu de recul, mais je pense que mon problème vient d'un blocage perso et un amalgame sur les commandes "SQL"...

Par contre, ce n'est pas le premier tuto de SilkyRoad que j'utilise et je les trouve bien fait et génial. Je pense juste que pour celui là, cela ne vient pas du tuto mais plutôt du lecteur... (comme dit le proverbe : 99% des problèmes informatique se trouvent entre la chaise et le clavier...)

Si je trouve ma solution dans le weekend, je la posterais avec ma compréhension et mes explications au cas où d'autres sont dans le même cas. Dans le cas contraire je poserais d'autres questions...

Invité · 12/03/2016, 09h49

Bonjour,

Si tu peux fournir un fichier Excel nettoyé de toute données confidentiel je te fournirai un exemple qui colle à ton fichier!

**Naru31** · 12/03/2016, 13h52

Merci rdurupt de ton aide.

Tu trouveras ci-joint mes fichiers.

En gros, comme dit précédement, je récupére les données de BDD TMT.xlsm dans TMT.xlsm (voir macro Import_Data dans le module Link_BDD) et là où je bloque c'est pour :
-renvoyer toutes mes données modifiées du TMT.xlsm dans BDD TMT.xlsm
-rajouter toutes les nouvelles données (nouvelles lignes) créé dans TMT.xlsm à la suite des données existantes dans BDD TMT.xlsm

Je vais aussi regarder de mon côté

Merci d'avance

**Naru31** · 13/03/2016, 04h12

Je pense avoir un peu compris comment ça marche mais j'ai l'impression que les requête SQL n'aime pas certain caractère, comme le "." ou "^", etc...

Y a-t-il moyen de lui faire accepter ces caractères...et existe-t-il une liste de caractère non accepter par ces requête ? ou sinon Est-ce mon code qui est mauvais ?

J'ai fait des boucles pour que ça analyse toutes mes données en long et en large (par ligne et par colonne)

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
Sub miseAJour_Enregistrement()
 
    Dim Cn As ADODB.Connection
    Dim Rst As ADODB.Recordset
    Dim BDD As String
    Dim SheetBDD As String, Req_SQL As String
    Dim valID As String, Header As String, valField As String
    Dim l_col, l_row
    Dim i, j
 
    'Définit le classeur fermé servant de base de données
    BDD = "C:\BDD TMT.xlsm"
    SheetBDD = "Topics"
    l_col = Sheets("Topics").Range("XFD1").End(xlToLeft).Column
    l_row = Sheets("Topics").Range("A1048576").End(xlUp).Row
 
    Set Cn = New ADODB.Connection
 
    '--- Connection ---
    With Cn
        .Provider = "Microsoft.Jet.OLEDB.4.0"
        .ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" _
            & BDD & ";Extended Properties=""Excel 12.0;HDR=YES;"""
        .Open
    End With
    '-----------------
 
    'Définit la requête.
 
    For i = 1 To l_row - 1
        valID = Sheets(SheetBDD).Range("A" & i + 1).Value
        For j = 1 To l_col - 1
            Header = Sheets(SheetBDD).Cells(1, j + 1).Value
            If Sheets(SheetBDD).Cells(i + 1, j + 1).Value <> "" Then
                valField = Sheets(SheetBDD).Cells(i + 1, j + 1).Value
                Req_SQL = "UPDATE [" & SheetBDD & "$] SET [" & Header & "]= '" & valField & "' WHERE [ID] = '" & valID & "';"
                Set Rst = Cn.Execute(Req_SQL)
            End If
        Next j
    Next i
 
    '--- Fermeture connexion ---
    Cn.Close
    Set Cn = Nothing
 
 
End Sub

Invité · 13/03/2016, 11h48

Bonjour,
Je n'ai pas trouvé le temps se me pencher en détail sur ton problème (vie familiale oblige) mai en attendant peut tu me dire ce que représente Header car à ce niveau il y avoir le nom du champ qui ce trouve sur la ligne 1 et la colonne respective!
Si un champ contient un [.] il faut le remplacer par [#].

De plus ce juste ça Cn.Execute Req_SQL

**Naru31** · 13/03/2016, 12h19

@ rdurupt : que tu n'ai pas trouvé le temps de te pencher sur mon sujet n'est absolument pas un problème, au contraire, je comprend tout à fait, et j'avoue aussi que je n'ai pas été non plus à 100% sur mon propre sujet vu que ma femme est en fin de grossesse...et c'est déjà sympa et gentil de ta part de participer et de consacrer un peu de temps à cette discussion

Pour "Header", cela correspond à mes intitulés de colonnes de la ligne 1 ([TOPIC], [Catégorie], etc...)

**Naru31** · 13/03/2016, 14h22

A priori ce code a l'air de bien fonctionner pour mettre à jour les données, et je n'ai plus de problème avec certains cararactères pour l'instant, et je n'ai pas fait grand chose à part limiter la modification à 1 seule ligne... Youpie !!

:

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
Sub Update_Data()
 
    Dim Cn As ADODB.Connection
    Dim Rst As ADODB.Recordset
    Dim BDD As String
    Dim SheetBDD As String, Req_SQL As String
    Dim valID As String, Header As String, valField As String
    Dim l_col, l_row
    Dim i, j
 
    'Définit le classeur fermé servant de base de données
    BDD = "C:\BDD.xlsm"
    SheetBDD = "Topics"
    l_col = Sheets("Topics").Range("XFD1").End(xlToLeft).Column
    l_row = Sheets("Topics").Range("A1048576").End(xlUp).Row
 
    Set Cn = New ADODB.Connection
 
    '--- Connection ---
    With Cn
        .Provider = "Microsoft.Jet.OLEDB.4.0"
        .ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" _
            & BDD & ";Extended Properties=""Excel 12.0;HDR=YES;"""
        .Open
    End With
    '-----------------
 
    'Définit la requête.
 
    For i = 1 To l_row - 1
        valID = Sheets(SheetBDD).Range("A" & i + 1).Value
        If valID = "xxxxx" Then
            For j = 1 To l_col - 1
                Header = Sheets(SheetBDD).Cells(1, j + 1).Value
                If Sheets(SheetBDD).Cells(i + 1, j + 1).Value <> "" Then
                    valField = Sheets(SheetBDD).Cells(i + 1, j + 1).Value
                    Req_SQL = "UPDATE [" & SheetBDD & "$] SET [" & Header & "]= '" & valField & "' WHERE [ID] = '" & valID & "';"
                    Set Rst = Cn.Execute(Req_SQL)
                End If
            Next j
        End If
    Next i
 
    '--- Fermeture connexion ---
    Cn.Close
    Set Cn = Nothing
 
End Sub

Mais je bloque maintenant sur l'enregistrement de nouvelle données (ajout de nouvelle ligne dans la BDD), quand j'exécute la macro ci-dessous, ben absolument rien ne se passe, pas d'erreur et pas d'enregistrement...

:

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
Sub Add_Data()
 
    Dim Cn As ADODB.Connection
    Dim Rst As ADODB.Recordset
    Dim BDD As String
    Dim SheetBDD As String, Req_SQL As String
    Dim valID As String, Header As String, valField As String
 
    'Définit le classeur fermé servant de base de données
    BDD = "C:\BDD.xlsm"
    SheetBDD = "Topics"
 
    Set Cn = New ADODB.Connection
 
    '--- Connection ---
    With Cn
        .Provider = "Microsoft.Jet.OLEDB.4.0"
        .ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" _
            & BDD & ";Extended Properties=""Excel 12.0;HDR=YES;"""
        .Open
    End With
    '-----------------
 
    'Définit la requête.
    Req_SQL = "INSERT INTO [Topics$] (ID,TOPIC) VALUES ('00-A0-0001','Test');"
 
    '--- Fermeture connexion ---
    Cn.Close
    Set Cn = Nothing
 
End Sub

Pourquoi ?

Invité · 13/03/2016, 15h19

Code :

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

1
2
3
4
5
Req_SQL = "INSERT INTO [Topics$] (ID,TOPIC) VALUES ('00-A0-0001','Test');"
 Cn.execute Req_SQL 
    '--- Fermeture connexion ---
    Cn.Close
    Set Cn = Nothing

Édite

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
53
Sub RequeteClasseurFermeMaj()
    Dim Cn As ADODB.Connection
    Dim BDD As String
    Dim SheetBDD As String, Req_SQL As String
    Dim Rst As ADODB.Recordset
 
    'Définit le classeur fermé servant de base de données
    BDD = ThisWorkbook.Path & "\BDD TMT.xlsm"
    SheetBDD = "Topics"
 
    Set Cn = New ADODB.Connection
 
    '--- Connection ---
    With Cn
        .Provider = "Microsoft.Jet.OLEDB.4.0"
        .ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" _
            & BDD & ";Extended Properties=""Excel 12.0;HDR=YES;"""
        .Open
    End With
    '-----------------
    Dim R As Range, L As Integer, rs As Object, C As Integer, sqlTitre As String, sqlValeur As String, Sql As String
    Set R = ThisWorkbook.Sheets("Topics").Range("A1").CurrentRegion
    For L = 2 To R.Rows.Count
    sqlTitre = "": sqlValeur = ""
        Set rs = CreateObject("adodb.recordset")
        rs.Open "select [ID] from [Topics$] where [ID]='" & R(L, 1) & "';", Cn
        If rs.EOF = False Then Sql = "Update [Topics$] set " Else Sql = "Insert Into [Topics$]  "
        For C = 1 To R.Columns.Count
            If rs.EOF = False Then
                If sqlValeur = "" Then sqlValeur = "[" & R(1, C) & "]=" & returValSql(R(L, C)) Else sqlValeur = sqlValeur & ",[" & R(1, C) & "]=" & returValSql(R(L, C))
            Else
                If sqlTitre = "" Then sqlTitre = "[" & R(1, C) & "]" Else sqlTitre = sqlTitre & "," & "[" & R(1, C) & "]"
                If sqlValeur = "" Then sqlValeur = returValSql(R(L, C)) Else sqlValeur = sqlValeur & "," & returValSql(R(L, C))
            End If
        Next
        If rs.EOF = False Then Cn.Execute Sql & sqlValeur  & " where [id] =" & returValSql(R(L, 1)) & ";"
             Else Cn.Execute Sql & " ( " & sqlTitre & " ) Values ( " & sqlValeur & " );"
        rs.Close: Set rs = Nothing
    Next
 
Cn.Close: Set Cn = Nothing
 
End Sub
 
 
Function returValSql(v As Range)
    If Trim("" & v.Text) = "" Then returValSql = "Null": Exit Function
    If IsDate(v.Text) = True And InStr(v.Text, "/") <> 0 And InStr(v.Text, ":") <> 0 Then returValSql = "#" & Format(v.Text, "yyyy-mm-dd hh:mm:ss") & "#": Exit Function
    If IsDate(v) = True And InStr(v.Text, "/") <> 0 And InStr(v.Text, ":") = 0 Then returValSql = "#" & Format(v.Text, "yyyy-mm-dd") & "#": Exit Function
    If IsNumeric(Replace(v.Text, ".", ",")) = True And InStr(v.Text, ":") <> 0 Then returValSql = "'" & Format(v.Text, "hh:mm:ss") & "'": Exit Function
    returValSql = "'" & Replace(v.Text, "'", "''") & "'"
 
End Function

**Naru31** · 13/03/2016, 20h41

Merci beaucoup de ton aide rdurupt ... pour l'instant je n'ai plus eu de problèmes avec lescaractères mais dans le doute je garde ton code de côté

Voici mon code qui fonctionne pour le moment, Youpie !!!

:

-Pour importer des données de ma BDD

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
53
Sub Import_Data_SQL()
'
'
' Macro made by Naru
 
'
    ' =Import Data= '
 
    '===========================================================================================
    'Statements
    '-------------------------------------------------------------------------------------------
    Dim Cn As ADODB.Connection
    Dim BDD As String
    Dim SheetBDD As String, Req_SQL As String
    Dim Rst As ADODB.Recordset
    '===========================================================================================
 
    '===========================================================================================
    'Boots
    '-------------------------------------------------------------------------------------------
    BDD = "C:\BDD.xlsm"
    SheetBDD = "Topics"
    '===========================================================================================
 
    '==>Init
    If Sheets(SheetBDD).Range("A2").Value <> "" Then
        Sheets(SheetBDD).Range(Rows("2:2"), Rows("2:2").End(xlDown)).Delete Shift:=xlUp
    End If
    Set Cn = New ADODB.Connection
 
 
    '==>Open connection
    With Cn
        .Provider = "Microsoft.Jet.OLEDB.4.0"
        .ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" _
            & BDD & ";Extended Properties=""Excel 12.0;HDR=YES;"""
        .Open
    End With
 
 
    '==>Request
    Req_SQL = "SELECT * FROM [" & SheetBDD & "$]"
    Set Rst = New ADODB.Recordset
    Set Rst = Cn.Execute(Req_SQL)
 
    '==>Update Data
    Sheets(SheetBDD).Range("A2").CopyFromRecordset Rst
 
    '==>Close connection
    Cn.Close
    Set Cn = Nothing
 
End Sub

-Pour mettre à jour des données dans ma BDD

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
53
54
55
56
57
58
59
60
61
62
63
64
65
66
Sub Update_Data_SQL()
'
'
' Macro made by Naru
 
'
    ' =Update Data= '
 
    '===========================================================================================
    'Statements
    '-------------------------------------------------------------------------------------------
    Dim Cn As ADODB.Connection
    Dim Rst As ADODB.Recordset
    Dim BDD As String
    Dim SheetBDD As String, Req_SQL As String
    Dim valID As String, Header As String, valField As String
    Dim l_col, l_row
    Dim i, j
    '===========================================================================================
 
    '===========================================================================================
    'Boots
    '-------------------------------------------------------------------------------------------
    BDD = "C:\BDD.xlsm"
    SheetBDD = "Topics"
    l_col = Sheets(SheetBDD).Range("XFD1").End(xlToLeft).Column
    l_row = Sheets(SheetBDD).Range("A1048576").End(xlUp).Row
    '===========================================================================================
 
    '==>Init
    Set Cn = New ADODB.Connection
 
 
    '==>Open connection
    With Cn
        .Provider = "Microsoft.Jet.OLEDB.4.0"
        .ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" _
            & BDD & ";Extended Properties=""Excel 12.0;HDR=YES;"""
        .Open
    End With
 
 
    '==>Request
    For i = 1 To l_row - 1
        valID = Sheets(SheetBDD).Cells(1 + i, 1).Value
        If valID = Sheets(SheetBDD).Range("DQ1").Value Then
            For j = 1 To l_col - 1
                Header = Sheets(SheetBDD).Cells(1, j + 1).Value
                If Sheets(SheetBDD).Cells(i + 1, j + 1).Value <> "" Then
                    valField = Sheets(SheetBDD).Cells(i + 1, j + 1).Value
                    Req_SQL = "UPDATE [" & SheetBDD & "$] SET [" & Header & "]= '" & valField & "' WHERE [ID] = '" & valID & "';"
                    Set Rst = Cn.Execute(Req_SQL)
                End If
            Next j
        End If
    Next i
 
 
    '==>Close connection
    Cn.Close
    Set Cn = Nothing
 
    '==>Import Data
    Call Import_Data_SQL
 
End Sub

-Pour ajouter des nouvelles données dans ma BDD

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
Sub Add_Data_SQL()
'
'
' Macro made by Naru
 
'
    ' =Add Data= '
 
    '===========================================================================================
    'Statements
    '-------------------------------------------------------------------------------------------
    Dim Cn As ADODB.Connection
    Dim Rst As ADODB.Recordset
    Dim BDD As String
    Dim SheetBDD As String, Req_SQL As String
    Dim valID As String
    '===========================================================================================
 
    '===========================================================================================
    'Boots
    '-------------------------------------------------------------------------------------------
    BDD = "C:\BDD.xlsm"
    SheetBDD = "Topics"
    '===========================================================================================
 
    '==>Init
    Set Cn = New ADODB.Connection
 
 
    '==>Open connection
    With Cn
        .Provider = "Microsoft.Jet.OLEDB.4.0"
        .ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" _
            & BDD & ";Extended Properties=""Excel 12.0;HDR=YES;"""
        .Open
    End With
 
 
    '==>Request
    valID = Sheets(SheetBDD).Range("DQ1").Value
    Req_SQL = "INSERT INTO [Topics$] (ID) VALUES ('" & valID & "');"
    Set Rst = Cn.Execute(Req_SQL)
 
 
    '==>Close connection
    Cn.Close
    Set Cn = Nothing
 
    '==>Update Request
    Call Update_Data_SQL
 
End Sub

Invité · 13/03/2016, 20h57

Avant d'insérer tes données il faut vérifier que l'id est bien absent de ton fichier!

**Naru31** · 14/03/2016, 08h57

J'y ai pensé, c'est déjà contrôlé dans le reste de mon programme !!!

**jfbonvin** · 03/03/2021, 22h22

Bonjour,

Votre code pour mettre à jour les données m'intéresse mais je ne le comprends pas et ne peux donc pas l'adapter.
Pouvez-vous m'expliquer son fonctionnement au niveau de la requête pour que je puisse l'adapter à mes classeurs dans lesquels, je souhaite mettre à jour la ligne de l'ID 100000005 du classeur DATA.xlsx avec les données du classeur Classeurs avec code VBA.xlsm

Je vous remercie d'avance

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
14
    '==>Request
    For i = 1 To l_row - 1
        valID = Sheets(SheetBDD).Cells(1 + i, 1).Value
        If valID = Sheets(SheetBDD).Range("DQ1").Value Then
            For j = 1 To l_col - 1
                Header = Sheets(SheetBDD).Cells(1, j + 1).Value
                If Sheets(SheetBDD).Cells(i + 1, j + 1).Value <> "" Then
                    valField = Sheets(SheetBDD).Cells(i + 1, j + 1).Value
                    Req_SQL = "UPDATE [" & SheetBDD & "$] SET [" & Header & "]= '" & valField & "' WHERE [ID] = '" & valID & "';"
                    Set Rst = Cn.Execute(Req_SQL)
                End If
            Next j
        End If
    Next i

Ecrire et Modifier dans un classeur .xlsm fermé [XL-2010]

Macros et VBA Excel

Discussions similaires

Partager

Partager