VBA - ODBC - Type TEXT dans mysql
Je remets le code de ma macro au complet
Sub ProduitDolibarrSQL()
Dim Server_Name As String
Dim Database_Name As String
Dim User_ID As String
Dim Password As String
Dim SQLStr As String
Dim Categorie As String
Dim Marque As String
Dim ValCat As String
Dim ValMarque As String
Dim Libelle As String
Dim Cn As ADODB.Connection
Set Cn = New ADODB.Connection
Dim rs As ADODB.Recordset
Set rs = New ADODB.Recordset
Server_Name = "MONSERVEUR"
Database_Name = "MABASE"
User_ID = "MONLOGINl"
Password = "MONPASSWORD"
With Sheets("Parametres")
ValCat = .Range("C4").Value
If ValCat = 0 Or ValCat > 60 Then Categorie = "" Else Categorie = .Range("B" & ValCat + 4).Value
End With
With Sheets("Parametres")
ValMarque = .Range("F4").Value
If ValMarque = 0 Or ValMarque > 60 Then Categorie = "" Else Marque = .Range("E" & ValMarque + 4).Value
End With
Libelle = Categorie & " " & Marque & " %"
SQLStr = "SELECT c.ref, c.label, c.fk_product_type, c.tosell, c.tobuy, c.description, c.url, c.customcode, c.fk_country, c.accountancy_code_sell, c.accountancy_code_sell_intra, c.accountancy_code_sell_export, c.accountancy_code_buy, c.accountancy_code_buy_intra, c.accountancy_code_buy_export, c.note, c.note_public, c.duration, c.finished, c.price_base_type, c.price, c.price_ttc, c.price_min, c.price_min_ttc, c.tva_tx, c.datec, c.cost_price, d.ref, c.tobatch, c.stock, c.seuil_stock_alerte, c.desiredstock, c.pmp, c.barcode, e.serieYesNo, e.deee, e.cpriv FROM llx_product c INNER JOIN llx_entrepot d ON c.fk_default_warehouse = d.rowid INNER JOIN llx_product_extrafields e ON c.rowid = e.fk_object WHERE c.label LIKE '" & Libelle & "' AND c.rowid = '1137'"
Cn.Open "Driver={MySQL ODBC 8.0 ANSI Driver};Server=" & Server_Name & ";Database=" & Database_Name & ";Uid=" & User_ID & ";Pwd=" & Password & ";"
rs.Open SQLStr, Cn, adOpenStatic
With Worksheets("Export Dolibarr").Range("A2")
.ClearContents
.CopyFromRecordset rs
End With
rs.Close
Set rs = Nothing
Cn.Close
Set Cn = Nothing
End Sub
Bonjour à tous,
Sans garantie, mais j'aurai tendance à écrire une requête multi-tables avec des parenthèses, du genre :
SQLStr = "SELECT ... FROM (table1 A INNER JOIN table2 B ON ...) INNER JOIN table3 C ON ..."
Pierre
sur MySql les parenthèses ne sont pas utiles
SQLStr = "SELECT ... FROM table1 A INNER JOIN table2 B ON ... INNER JOIN table3 C ON ..."
Bonjour,
En continuant mes recherches hier soir, je suis tombé sur ce code la
Sub ProduitDolibarrSQL()
Dim Server_Name As String
Dim Database_Name As String
Dim User_ID As String
Dim Password As String
Dim SQLStr As String
Dim Categorie As String
Dim Marque As String
Dim ValCat As String
Dim ValMarque As String
Dim Libelle As String
Dim DernierLigneSQL As String
Dim Cn As ADODB.Connection
Set Cn = New ADODB.Connection
Dim rs As ADODB.Recordset
Set rs = New ADODB.Recordset
Server_Name = "MONIP"
Database_Name = "MABASE"
User_ID = "MONID"
Password = "MONPASS"
With Sheets("Parametres")
ValCat = .Range("C4").Value
If ValCat = 0 Or ValCat > 60 Then Categorie = "" Else Categorie = .Range("B" & ValCat + 4).Value
End With
With Sheets("Parametres")
ValMarque = .Range("F4").Value
If ValMarque = 0 Or ValMarque > 60 Then Categorie = "" Else Marque = .Range("E" & ValMarque + 4).Value
End With
Libelle = Categorie & " " & Marque & " %"
SQLStr = "SELECT c.ref, c.label, c.fk_product_type, c.tosell, c.tobuy, c.description, c.url, c.customcode, c.fk_country, c.accountancy_code_sell, c.accountancy_code_sell_intra, c.accountancy_code_sell_export, c.accountancy_code_buy, c.accountancy_code_buy_intra, c.accountancy_code_buy_export, c.note, c.note_public, c.duration, c.finished, c.price_base_type, c.price, c.price_ttc, c.price_min, c.price_min_ttc, c.tva_tx, c.datec, c.cost_price, d.ref, c.tobatch, c.stock, c.seuil_stock_alerte, c.desiredstock, c.pmp, c.barcode, e.serieYesNo, e.deee, e.cpriv FROM llx_product c INNER JOIN llx_entrepot d ON c.fk_default_warehouse = d.rowid INNER JOIN llx_product_extrafields e ON c.rowid = e.fk_object WHERE c.label LIKE '" & Libelle & "' "
Cn.Open "Driver={MySQL ODBC 8.0 ANSI Driver};Server=" & Server_Name & ";Database=" & Database_Name & ";Uid=" & User_ID & ";Pwd=" & Password & ";"
rs.Open SQLStr, Cn, adOpenStatic
Set f = rs.Fields
ncol = f.Count - 1 ' nombre de champs de la réponse
i = 1
For j = 0 To ncol
Cells(i, j + 1) = f.Item(j).Name 'on met les noms des champs en ligne 1
Next
Do Until rs.EOF = True ' tant qu'il y a des lignes dans la réponse
i = i + 1
For j = 0 To ncol
Cells(i, j + 1) = f.Item(j).Value ' on copie les champs
Next
rs.MoveNext ' on passe à la ligne suivante de la réponse
Loop
r.Close
Set r = Nothing
c.Close
Set c = Nothing
Et la, la magie opère, ça marche. Je recupère toutes mes infos correctement... Mais... Bah oui il y a un mais sinon s'est pas drôle... c'est suuuuuuuuper lent...
AU bout de 5min, il n'avait même pas encore écrit 100 lignes... alors que je pourrai en avoir plusieurs centaines à traiter par la suite.
Bonjour,
je ne comprends pas,tu avais bien fait un truc comme ça au début de la discussion ?
For i=0 to rs.Fields.count - 1
Range("A1"). offset (0,i)= rs.Fields(i).Name
Next
range("A2").CopyFromRecordSet rs
rs.close
set RS=nothing
Non au debut j'avais ça dans mon code
With Worksheets("Export Dolibarr").Range("A2")
.ClearContents
.CopyFromRecordset rs
End With
J'ai repris votre bout de code, ce qui donne maintenant ceci
Sub ProduitDolibarrSQL()
Dim Server_Name As String
Dim Database_Name As String
Dim User_ID As String
Dim Password As String
Dim SQLStr As String
Dim Categorie As String
Dim Marque As String
Dim ValCat As String
Dim ValMarque As String
Dim Libelle As String
Dim DernierLigneSQL As String
Dim Cn As ADODB.Connection
Set Cn = New ADODB.Connection
Dim rs As ADODB.Recordset
Set rs = New ADODB.Recordset
Server_Name = "MONIP"
Database_Name = "MABASE"
User_ID = "MONUSER"
Password = "MONMDP"
With Sheets("Parametres")
ValCat = .Range("C4").Value
If ValCat = 0 Or ValCat > 60 Then Categorie = "" Else Categorie = .Range("B" & ValCat + 4).Value
End With
With Sheets("Parametres")
ValMarque = .Range("F4").Value
If ValMarque = 0 Or ValMarque > 60 Then Categorie = "" Else Marque = .Range("E" & ValMarque + 4).Value
End With
Libelle = Categorie & " " & Marque & " %"
SQLStr = "SELECT c.ref, c.label, c.fk_product_type, c.tosell, c.tobuy, c.description, c.url, c.customcode, c.fk_country, c.accountancy_code_sell, c.accountancy_code_sell_intra, c.accountancy_code_sell_export, c.accountancy_code_buy, c.accountancy_code_buy_intra, c.accountancy_code_buy_export, c.note, c.note_public, c.duration, c.finished, c.price_base_type, c.price, c.price_ttc, c.price_min, c.price_min_ttc, c.tva_tx, c.datec, c.cost_price, d.ref, c.tobatch, c.stock, c.seuil_stock_alerte, c.desiredstock, c.pmp, c.barcode, e.serieYesNo, e.deee, e.cpriv FROM llx_product c INNER JOIN llx_entrepot d ON c.fk_default_warehouse = d.rowid INNER JOIN llx_product_extrafields e ON c.rowid = e.fk_object WHERE c.label LIKE '" & Libelle & "' "
Cn.Open "Driver={MySQL ODBC 8.0 ANSI Driver};Server=" & Server_Name & ";Database=" & Database_Name & ";Uid=" & User_ID & ";Pwd=" & Password & ";"
rs.Open SQLStr, Cn, adOpenStatic
For i = 0 To rs.Fields.Count - 1
Range("A1").Offset(0, i) = rs.Fields(i).Name
Next
Range("A2").CopyFromRecordset rs
rs.Close
Set rs = Nothing
' With Worksheets("Export Dolibarr").Range("A2")
' .ClearContents
' .CopyFromRecordset rs
' End With
Set rs = Nothing
Cn.Close
Set Cn = Nothing
End Sub
Donc la, l'exécution de la macro est quasi instantanée.
Par contre, je me retrouve dans le même souci que j'avais évoqué dans un post un peu plus haut, les données qui sont récupéré dans la colonne description son tronqué. Je n'ai que les 66 1er caractères j'ai l'impression
Sub ProduitDolibarrSQL()
Dim Server_Name As String, Database_Name As String, User_ID As String, Password As String, SQLStr As String, Categorie As String, Marque As String
Dim ValCat As String, ValMarque As String, Libelle As String, DernierLigneSQL As String, tb
Server_Name = "MONIP": Database_Name = "MABASE": User_ID = "MONUSER": Password = "MONMDP"
With Sheets("Parametres")
ValCat = .Range("C4").Value
If ValCat = 0 Or ValCat > 60 Then Categorie = "" Else Categorie = .Range("B" & ValCat + 4).Value
ValMarque = .Range("F4").Value
If ValMarque = 0 Or ValMarque > 60 Then Categorie = "" Else Marque = .Range("E" & ValMarque + 4).Value
End With
Libelle = Categorie & " " & Marque & " %"
SQLStr = "SELECT c.ref, c.label, c.fk_product_type, c.tosell, c.tobuy, c.description, c.url, c.customcode, c.fk_country, c.accountancy_code_sell, c.accountancy_code_sell_intra, c.accountancy_code_sell_export, c.accountancy_code_buy, c.accountancy_code_buy_intra, c.accountancy_code_buy_export, c.note, c.note_public, c.duration, c.finished, c.price_base_type, c.price, c.price_ttc, c.price_min, c.price_min_ttc, c.tva_tx, c.datec, c.cost_price, d.ref, c.tobatch, c.stock, c.seuil_stock_alerte, c.desiredstock, c.pmp, c.barcode, e.serieYesNo, e.deee, e.cpriv FROM llx_product c INNER JOIN llx_entrepot d ON c.fk_default_warehouse = d.rowid INNER JOIN llx_product_extrafields e ON c.rowid = e.fk_object WHERE c.label LIKE '" & Libelle & "' "
With New ADODB.Connection
.Open "Driver={MySQL ODBC 8.0 ANSI Driver};Server=" & Server_Name & ";Database=" & Database_Name & ";Uid=" & User_ID & ";Pwd=" & Password & ";"
With .Execute(SQLStr)
For i = 0 To .Fields.Count - 1
Range("A1").Offset(0, i) = .Fields(i).Name
Next
If Not .EOF Then
tb = Application.Transpose(.GetRows)
Range("A2").Resize(UBound(tb, 1), UBound(tb, 2)) = tb
End If
.Close
End With
.Close
End With
End Sub
Bonjour à tous,
Ici l'erreur vient du fait qu'une des valeurs lues est probablement égale à NULL.
Pour contourner, il suffit d'utiliser sa propre fonction Transpose, voici la mienne (c'est cadô) à coller telle quel dans un des modules
Function Transpose(Ttk As Variant) As Variant
Dim T As Variant, lg As Long, cl As Long, i As Long, j As Long
lg = UBound(Ttk, 1)
cl = UBound(Ttk, 2)
ReDim T(LBound(Ttk, 2) To cl, LBound(Ttk, 1) To lg)
For i = LBound(Ttk, 2) To cl
For j = LBound(Ttk, 1) To lg
T(i, j) = Ttk(j, i)
Next j
Next i
Transpose = T
End Function
L'appel devient tout simplement:
tb = Transpose(.GetRows)
tb étant déclaré en tant que variant (comme ceci c'est plus explicite) :
Dim tb AS Variant
Pierre
Bonjour à tous,
Effectivement, il y a des valeurs qui était à NULL.
Merci pour cette fonction qui résout le souci. Du coup tout à l'air fonctionnelle maintenant.
Merci à tous pour votre aide :)