XL 2013 Function--> récupérer recordset

[hctad1]

Bonjour,
comme j'ai (très) souvent cette requête à faire pour récupérer l'id_produit dans ma base:
select products_id from products where products_model="ma_ref";

Je souhaite me créer une petite function de ce type dans personal.xlsm
=model_to_id(la_cellule) ou ma_ref est dans "la_cellule"

Je bute sur la méthode pour récupérer le recordset (qui sera toujours unique) et le mettre en résultat.

Une idée.

Function model_to_id(la_cellule1)


   Dim Password As String
    Dim SQLStr As String
    Dim Server_Name As String
    Dim User_ID As String
    Dim Database_Name As String
    Dim table_name As String
  
  
    Set Rs = CreateObject("ADODB.Recordset")
    Server_Name = "mon_serveur"
    Database_Name = "ma_base"
    User_ID = "mon_utilisateur"
    Password = "monmotdepasse"
      Set cn = CreateObject("ADODB.Connection")
    cn.Open "Driver={MySQL ODBC 3.51 Driver};Server=" & _
            Server_Name & ";Database=" & Database_Name & _
            ";Uid=" & User_ID & ";Pwd=" & Password & ";"
    
    SQLStr = "select products_id from products where products_model='" & la_cellule1 & "'"
    Rs.Open SQLStr, cn, adOpenStatic

    'je colle le resultat   dans la bonne cellule
model_to_id = ????
End Function

 

[Hasco]

re,

Si vous voulez tester ce qui cloche, utilisez votre fonction dans la fenêtre d'exécution (CTRL+G) en l'appelant comme ci-dessous (point d'interrogation inclus) et avant de valider, insérez un point d' arrêt au début de votre fonction pour pouvoir la dérouler ensuite en pas à pas par F8. Affichez également la fenêtre variables locales si vous avez choisit le modèle avec variables.

?model_to_id(12548c)

Vous aurez ainsi accès au message d'erreur, que vous ne pouvez pas avoir en l'appelant d'une cellule.
Cordialement

 

[dysorthographie]

moi je suis en MySQL ODBC 8.0, mais voila ce qui fonctionne chez moi!

Public Const PassWord = "xxxx", Server = "localhost", User = "root", DataBase = "toto", Port = 3306
Public Const Connexion = "Driver={MySQL ODBC 8.0 Unicode Driver};Server=" & Server & ";Port=" & Port & ";Database=" & DataBase & ";User=" & User & ";Password=" & PassWord & ";"
Function model_to_id(la_cellule1 As String) As Integer
With CreateObject("ADODB.connection")
    .Open Connexion
    With .Execute("select products_id from products where products_model='" & la_cellule1 & "'")
    If Not .EOF Then model_to_id = .Fields(0)
    .Close
    End With
    .Close
End With
End Function
Sub test()
model_to_id "toto"
End Sub

 

[hctad1]

Re,

A mon avis (mais ce n'est que mon avis) il vous faut enlever les ' de votre requête pour lui passer l'entier.

Le point-virgule final est parfois important.

Cordialement

non puisque products_model est un txt, il doit etre entre quote ou double quote.
En règle générale, je termine tjrs mes requêtes par un ; mais d'expérience que ce soit en en php ou vba cela n'a que rarement d'impact.

 

[hctad1]

quel est ton dernier code qui à fonctionné!

tout bête:
Sub model_to_id()

Dim Password As String
Dim SQLStr As String
Dim Server_Name As String
Dim User_ID As String
Dim Database_Name As String
Dim table_name As String


Set RS = CreateObject("ADODB.Recordset")
Server_Name = r"
Database_Name = ""
User_ID = ""
Password = ""
Set Cn = CreateObject("ADODB.Connection")
Cn.Open "Driver={MySQL ODBC 3.51 Driver};Server=" & _
Server_Name & ";Database=" & Database_Name & _
";Uid=" & User_ID & ";Pwd=" & Password & ";"
SQLStr = "select products_id from products where products_model='" & Range("B16") & "'"
MsgBox SQLStr
RS.Open SQLStr, Cn, adOpenStatic

Sheets("consultation").Range("i3").CopyFromRecordset RS

End Sub

 

[Hasco]

Re,

Vous avez tenté d'enlever les ' qui entourent votre paramètre de la requête ?

Vous disiez au post #13 :

Oui mon products_id est integer

Cordialement

 

[hctad1]

Re,

Vous avez tenté d'enlever les ' qui entoure votre paramètre de la requête ?

Cordialement

oui pour vous faire plaisir mais ça retourne, et c'est logique, une erreur mysql.

 

[hctad1]

re,

Si vous voulez tester ce qui cloche, utilisez votre fonction dans la fenêtre d'exécution (CTRL+G) en l'appelant comme ci-dessous (point d'interrogation inclus) et avant de valider, insérez un point d' arrêt au début de votre fonction pour pouvoir la dérouler ensuite en pas à pas par F8. Affichez également la fenêtre variables locales si vous avez choisit le modèle avec variables.

Vous aurez ainsi accès au message d'erreur, que vous ne pouvez pas avoir en l'appelant d'une cellule.
Cordialement

Merci pour la méthode, c'est bien pratique.

Alors donc, sur la base de mon nouveau code:
?model_to_id(ALA7308)
me retourne bien une valeur.
Mieux: celle que j'attendais

pour autant, si je veux saisir la function dans une cellule je me fais jeter.

 

[Hasco]

Re,

Ben, c'est normal, vous appelez un procédure (sub), pas une fonction (function) !
Une sub ne retourne pas de valeur, une fonction oui

Il vous faut transformer votre Sub en fonction :

Function model_to_id()

Dim Password As String
Dim SQLStr As String
Dim Server_Name As String
Dim User_ID As String
Dim Database_Name As String
Dim table_name As String


Set RS = CreateObject("ADODB.Recordset")
Server_Name = r"
Database_Name = ""
User_ID = ""
Password = ""
Set Cn = CreateObject("ADODB.Connection")
Cn.Open "Driver={MySQL ODBC 3.51 Driver};Server=" & _
Server_Name & ";Database=" & Database_Name & _
";Uid=" & User_ID & ";Pwd=" & Password & ";"
SQLStr = "select products_id from products where products_model='" & Range("B16") & "'"
MsgBox SQLStr
RS.Open SQLStr, Cn, adOpenStatic

modele_to_id = RS.Fields(0)

End Sub

Cordialement

 

[Hasco]

Re,

je pense à un truc : votre function n'aurez pas le même nom qu'une sub ?

cordialement

 

[hctad1]

Re,

Ben, c'est normal, vous appelez un procédure (sub), pas une fonction (function) !
Une sub ne retourne pas de valeur, une fonction oui

Il vous faut transformer votre Sub en fonction :

Function model_to_id()

Dim Password As String
Dim SQLStr As String
Dim Server_Name As String
Dim User_ID As String
Dim Database_Name As String
Dim table_name As String


Set RS = CreateObject("ADODB.Recordset")
Server_Name = r"
Database_Name = ""
User_ID = ""
Password = ""
Set Cn = CreateObject("ADODB.Connection")
Cn.Open "Driver={MySQL ODBC 3.51 Driver};Server=" & _
Server_Name & ";Database=" & Database_Name & _
";Uid=" & User_ID & ";Pwd=" & Password & ";"
SQLStr = "select products_id from products where products_model='" & Range("B16") & "'"
MsgBox SQLStr
RS.Open SQLStr, Cn, adOpenStatic

modele_to_id = RS.Fields(0)

End Sub

Cordialement

C'est juste un exemple de la sub qui fonctionne.
l'autre est bien une fonction.

 

[Hasco]

Re,

Ok, mais elles ne doivent pas avoir le même nom

 

[hctad1]

Re,

je pense à un truc : votre function n'aurez pas le même nom qu'une sub ?

cordialement

Bingo, on dirait que c'est la réponse. Pas le temps de finir, Madame me sort à un apéro
Merci.

 

[dysorthographie]

Voila

Function model_to_id(la_cellule1 As String) As Integer
Dim Password As String
Dim SQLStr As String
Dim Server_Name As String
Dim User_ID As String
Dim Database_Name As String
Dim table_name As String


Set Rs = CreateObject("ADODB.Recordset")
Server_Name = "r"
Database_Name = ""
User_ID = ""
Password = ""
Set Cn = CreateObject("ADODB.Connection")
Cn.Open "Driver={MySQL ODBC 3.51 Driver};Server=" & _
Server_Name & ";Database=" & Database_Name & _
";Uid=" & User_ID & ";Pwd=" & Password & ";"
SQLStr = "select products_id from products where products_model='" & la_cellule1 & "'"
MsgBox SQLStr
Rs.Open SQLStr, Cn, adOpenStatic

If Not Rs.EOF Then model_to_id = Rs("products_id")

End Function

 

[hctad1]

Bonjour à tous,
je progresse mais il me reste un souci.
Je n'ai plus le souci de nom de fonction (quel idiot !)
la requête est bien exécutée.
elle renvoie bien un résultat.

si je fais un msgbox sur Rs("products_id"), la valeur affichée est correcte.

en revanche, le résultat dans la cellule est 0.

et si je m'amuse à faire ceci
le_resultat = 10
If Not Rs.EOF Then model_to_id = le_resultat

la valeur de la cellule reste zéro.
?

 

[patricktoulon]

Bonjour
je sais pas mais si tu tape avant le rs(EOF) il est évident que tu aura q'une partie du recordset
si je me trompe pas on pourrait traduire EOF par "jusqu'a la fin" ou "en entier"