Renvoie de donnée à une base MySQL

Le 25/08/2021 à 21:34

Salutations,

Je souhaite renvoyé des données issue d'un tableau Excel vers une base SQL, mais le code SQL que j'utilise ne fonctionne pas et affiche un message d'erreur sur l'incompatibilité de type pour ma dernier requête.

Sub test()

Dim I As Integer

    Const Server = "LocalHost", Port = "3306", User = "root", Password = "": Dim DataBase
With CreateObject("ADODB.Connection")
        .Open "Driver={MySQL ODBC 8.0 Unicode Driver};Server=" & Server & ";Port=" & Port & ";Database=" & DataBase & ";User=" & User & ";Password=" & Password & ";"
            requete = "CREATE DATABASE IF NOT EXISTS `vbamysql` DEFAULT CHARACTER SET utf8 COLLATE utf8_general_ci;"
            .Execute requete
        .Close
        DataBase = "vbamysql"
        .Open "Driver={MySQL ODBC 8.0 Unicode Driver};Server=" & Server & ";Port=" & Port & ";Database=" & DataBase & ";User=" & User & ";Password=" & Password & ";"
             requete = "CREATE TABLE IF NOT EXISTS  `voitures`" & vbCrLf & _
                       "(`id` INTEGER NOT NULL auto_increment,`marque` VARCHAR(25) NOT NULL,`modele` VARCHAR(25) NOT NULL ,`cv` INTEGER," & vbCrLf & _
                       "PRIMARY KEY (`id`),UNIQUE (`modele`)) ENGINE = InnoDB ;"
        .Execute requete
        .Close

         For I = 1 To 6
            a0 = ThisWorkbook.Sheets("traitement").Cells(I, 1).Value
            a1 = ThisWorkbook.Sheets("traitement").Cells(I, 2).Value
            a2 = ThisWorkbook.Sheets("traitement").Cells(I, 3).Value
            a3 = ThisWorkbook.Sheets("traitement").Cells(I, 4).Value

        DataBase = "vbamysql1"
        .Open "Driver={MySQL ODBC 8.0 Unicode Driver};Server=" & Server & ";Port=" & Port & ";Database=" & DataBase & ";User=" & User & ";Password=" & Password & ";"
        requete = "INSERT INTO voitures(id, marque, modele, cv) VALUES(" & _
                    a0 & ",'" & _
                    a1 & "', '" & _
                    a2 & "', " & _
                    a3 & ")"
        .Execute requete
        Next

        .Close
End With
End Sub
Le 26/08/2021 à 00:59

bonsoir,

2 remarques/suggestions

- la référence à vbamysql puis vbamysql1 est-elle voulue ?

- le contenu de id est en principe géré par mysql (auto increment) et donc il ne faut pas lui assigner de valeur et le supprimer de l'instruction insert.

Le 26/08/2021 à 12:15

Bonjour à tous,

Tiens, du code qui me rappelle qqchose ...

Sur ma page le code proposé est fonctionnel à 100% =>

http://tatiak.canalblog.com/archives/2014/04/06/29605283.html

@H2So4 : à partir d'excel l'auto-incrément d'un Id d'une table MySql n'est pas opérant, il convient de le faire "manuellement" par exemple avec un SELECT MAX(`Id`)+1

Pierre

Le 26/08/2021 à 13:54

@pierrep56,

@H2So4 : à partir d'excel l'auto-incrément d'un Id d'une table MySql n'est pas opérant, il convient de le faire "manuellement" par exemple avec un SELECT MAX(`Id`)+1

Merci Pierre pour cette info ! j'ai encore appris quelque chose, ;o)

Le 26/08/2021 à 18:45

Bonjour,

Id est auto-incrément soit tu connais sa valeur dans a0 soit tu laisse MySql le gérer dans ce cas tu supprimes ID de ta requête!

Dim a0 As String, a1 As String, a2 As String, a3 As String
 For I = 1 To 6
            a0 = ThisWorkbook.Sheets("traitement").Cells(I, 1).Value
            a1 = ThisWorkbook.Sheets("traitement").Cells(I, 2).Value
            a2 = ThisWorkbook.Sheets("traitement").Cells(I, 3).Value
            a3 = ThisWorkbook.Sheets("traitement").Cells(I, 4).Value
             requete = "INSERT INTO voitures(id, marque, modele, cv) VALUES(" & _
                   TrouveTypeSql(a0) & "," & _
                    TrouveTypeSql(a1) & "," & _
                    TrouveTypeSql(a2) & "," & _
                    TrouveTypeSql(a3) & ")"
 .Execute requete
        Next

        .Close
End With
End Sub
Function TrouveTypeSql(V)
TrouveTypeSql = Trim("" & V)
If Trim("" & TrouveTypeSql) = "" Then TrouveTypeSql = "Null": Exit Function
If IsDate(TrouveTypeSql) = True And InStr(TrouveTypeSql, "/") <> 0 And InStr(TrouveTypeSql, ":") <> 0 Then TrouveTypeSql = "'" & Format(TrouveTypeSql, "yyyy-mm-dd hh:mm") & "'": Exit Function
If IsDate(TrouveTypeSql) = True And InStr(TrouveTypeSql, "/") <> 0 Then TrouveTypeSql = "'" & Format(TrouveTypeSql, "yyyy-mm-dd") & "'": Exit Function
If IsNumeric(Replace(TrouveTypeSql, ".", ",")) = True Then TrouveTypeSql = Replace(TrouveTypeSql, ",", "."): Exit Function
TrouveTypeSql = "'" & Replace(TrouveTypeSql, "'", "''") & "'"
End Function
Le 26/08/2021 à 20:30

Alors h2so4 merci pour ton aide il y avait une erreur sur la désignation de vbamysql. J'ai modifier ma base de données Excel pour faire correspondre les deux bases bases de données. Quant à ton code Dysorthographie

Sub test2()

Dim I As Integer
Dim a0 As String, a1 As String, a2 As String, a3 As String

Const Server = "LocalHost", Port = "3306", User = "root", Password = "": Dim DataBase
With CreateObject("ADODB.Connection")
        For I = 1 To 10
            a0 = ThisWorkbook.Sheets("traitement").Cells(I, 1).Value
            a1 = ThisWorkbook.Sheets("traitement").Cells(I, 2).Value
            a2 = ThisWorkbook.Sheets("traitement").Cells(I, 3).Value
            a3 = ThisWorkbook.Sheets("traitement").Cells(I, 4).Value
            DataBase = "vbamysql"
        .Open "Driver={MySQL ODBC 8.0 Unicode Driver};Server=" & Server & ";Port=" & Port & ";Database=" & DataBase & ";User=" & User & ";Password=" & Password & ";"
             requete = "INSERT INTO voitures( id,marque, modele, cv) VALUES(" & _
                   TrouveTypeSql(a0) & "," & _
                    TrouveTypeSql(a1) & "," & _
                    TrouveTypeSql(a2) & "," & _
                    TrouveTypeSql(a3) & ")"
        .Execute requete
        .Close
        Next

End With
End Sub
Function TrouveTypeSql(V)
TrouveTypeSql = Trim("" & V)
If Trim("" & TrouveTypeSql) = "" Then TrouveTypeSql = "Null": Exit Function
If IsDate(TrouveTypeSql) = True And InStr(TrouveTypeSql, "/") <> 0 And InStr(TrouveTypeSql, ":") <> 0 Then TrouveTypeSql = "'" & Format(TrouveTypeSql, "yyyy-mm-dd hh:mm") & "'": Exit Function
If IsDate(TrouveTypeSql) = True And InStr(TrouveTypeSql, "/") <> 0 Then TrouveTypeSql = "'" & Format(TrouveTypeSql, "yyyy-mm-dd") & "'": Exit Function
If IsNumeric(Replace(TrouveTypeSql, ".", ",")) = True Then TrouveTypeSql = Replace(TrouveTypeSql, ",", "."): Exit Function
TrouveTypeSql = "'" & Replace(TrouveTypeSql, "'", "''") & "'"
End Function

que j'ai intégré, Visual Basic m'affiche un message d'erreur sur une histoire de duplicata sur la clé primaire, j'ai essaie avec et sans id, ça ne change rien et lorsque j'insère un INGRORE c'est la galère.

image
Le 26/08/2021 à 22:38

Id est auto-incrément donc risque de doublon de clé primaire mais c'est ton code qui en est la code pas le miens

a0 = ThisWorkbook.Sheets("traitement").Cells(I, 1).Value
            a1 = ThisWorkbook.Sheets("traitement").Cells(I, 2).Value
            a2 = ThisWorkbook.Sheets("traitement").Cells(I, 3).Value
            a3 = ThisWorkbook.Sheets("traitement").Cells(I, 4).Value
Le 27/08/2021 à 00:59
requete = "INSERT INTO voitures( marque, modele, cv) VALUES(" & _
                    TrouveTypeSql(a1) & "," & _
                    TrouveTypeSql(a2) & "," & _
                    TrouveTypeSql(a3) & ")"
        .Execute requete

sans id

Le 27/08/2021 à 12:12

Alors j'ai enlevé le id et lancer le code et le problème persiste :

image

Voici le deux bases de donnés

image
Le 27/08/2021 à 12:15

Pourtant le code SQL fonctionne sur PhpMyAdmin

Le 27/08/2021 à 12:42

bonjour,

dans la création de la DB tu as indiqué que modèle est une clé unique (il ne peut donc pas y avoir de double pour ce champ) ce que t'indiques le message d'erreur. (lignes 1,2 et 4,5 de ton excel si j'ai bien lu ta copie d'écran).

Le 27/08/2021 à 12:59

Bonjour,

En fait ma première proposition fonctionne c'est t'a création de table qu'il faut revoir si tu as plusieurs fois le même modèle !

tu peux définir une clé non unique si tu veux indexer le champ modèle.

Le 27/08/2021 à 13:38

Alors en effet, le problème venait de la propriété Unique , en récrivant le code pour le supprimé, les valeur transite d'une base à l'autre.

Sub testcv()

Dim I As Integer

    Const Server = "LocalHost", Port = "3306", User = "root", Password = "": Dim DataBase
With CreateObject("ADODB.Connection")
        .Open "Driver={MySQL ODBC 8.0 Unicode Driver};Server=" & Server & ";Port=" & Port & ";Database=" & DataBase & ";User=" & User & ";Password=" & Password & ";"
            requete = "CREATE DATABASE IF NOT EXISTS `vbamysql2` DEFAULT CHARACTER SET utf8 COLLATE utf8_general_ci;"
            .Execute requete
        .Close
        DataBase = "vbamysql2"
       .Open "Driver={MySQL ODBC 8.0 Unicode Driver};Server=" & Server & ";Port=" & Port & ";Database=" & DataBase & ";User=" & User & ";Password=" & Password & ";"
            requete = "CREATE TABLE IF NOT EXISTS  `voitures`" & vbCrLf & _
                        "(`id` INTEGER NOT NULL auto_increment,`marque` VARCHAR(25) NOT NULL,`modele` VARCHAR(25) NOT NULL ,`cv` INTEGER," & vbCrLf & _
                        "PRIMARY KEY (`id`)) ENGINE = InnoDB ;"
        .Execute requete
        .Close

         For I = 1 To 10
            a0 = ThisWorkbook.Sheets("traitement").Cells(I, 1).Value
            a1 = ThisWorkbook.Sheets("traitement").Cells(I, 2).Value
            a2 = ThisWorkbook.Sheets("traitement").Cells(I, 3).Value
            a3 = ThisWorkbook.Sheets("traitement").Cells(I, 4).Value

        DataBase = "vbamysql2"
       .Open "Driver={MySQL ODBC 8.0 Unicode Driver};Server=" & Server & ";Port=" & Port & ";Database=" & DataBase & ";User=" & User & ";Password=" & Password & ";"
           requete = "INSERT INTO voitures( marque, modele, cv) VALUES(" & _
                    TrouveTypeSql(a1) & "," & _
                    TrouveTypeSql(a2) & "," & _
                    TrouveTypeSql(a3) & ")"
        .Execute requete
        .Close
        Next

End With
End Sub

Function TrouveTypeSql(V)
TrouveTypeSql = Trim("" & V)
If Trim("" & TrouveTypeSql) = "" Then TrouveTypeSql = "Null": Exit Function
If IsDate(TrouveTypeSql) = True And InStr(TrouveTypeSql, "/") <> 0 And InStr(TrouveTypeSql, ":") <> 0 Then TrouveTypeSql = "'" & Format(TrouveTypeSql, "yyyy-mm-dd hh:mm") & "'": Exit Function
If IsDate(TrouveTypeSql) = True And InStr(TrouveTypeSql, "/") <> 0 Then TrouveTypeSql = "'" & Format(TrouveTypeSql, "yyyy-mm-dd") & "'": Exit Function
If IsNumeric(Replace(TrouveTypeSql, ".", ",")) = True Then TrouveTypeSql = Replace(TrouveTypeSql, ",", "."): Exit Function
TrouveTypeSql = "'" & Replace(TrouveTypeSql, "'", "''") & "'"
End Function

Alors Merci encore dysorthographie et h2so4

Rechercher des sujets similaires à "renvoie donnee base mysql"