Extraction de donnée par ADO ACCESS vers Excel

Version imprimable

11/05/2009, 10h59
roidurif

1 pièce(s) jointe(s)

Extraction de donnée par ADO ACCESS vers Excel

Bonjour,

Je suis actuellement en train d'essayer de lier une base access avec un tableur excel (le tableur me servant à calculer mes variation de tarifs, la base access à enregistrer les prix de mes fournisseurs).

Je me suis servi de ce tutoriel, qui semble correspondre à ce que je souhaite faire (dernière méthode, via ADO) :

http://cafeine.developpez.com/access/tutoriel/excel/

Seulement voilà, ça ne semble pas fonctionner chez moi, et je ne vois pas pourquoi. Je tourne en rond depuis ce we.

L'exemple étant assez facile à rééditer, je me dis que si certains ont des connaissances sur cette question, ils verront certainement mieux que moi d'où ça vient. Le but, c'est de récupéré les prix + produit à partir d'une recherche date de début et fin et numéro de contrat.

J'ai une base : BDD.mdb
Dans cette base, une table "FOURNISSEUR", avec les champs suivants :
Champ "NUMERO_CONTRAT (reel simple, en euro)
Champ "REF_PRODUIT" (texte)
Champ "PRIX_UNITE_UTILISE" (reel simple, en euro)
Champ "DATE_DEBUT" (date)
Champ "DATE_FIN" (date)

Si quelqu'un peu m'aider SVP, Merci d'avance

Salut,

Ce n'est qu'un probleme de requete SQL, la table dans la requete n'est pas la bonne
(plus le WHERE 1=1 qui me derange...)

Remplace

Code:

1
2
3
4
5
6
    strSQL = "SELECT [PRIX_UNITE_HT] AS MONTANT " & _
             "FROM [qryXLSlookup] WHERE 1=1"
 
    If Len(Référence) > 0 Then
        strSQL = strSQL & " And ([REF_PRODUIT] = '" & Référence & "')"
    End If

par

Code:

1
2
3
4
5
6
    strSQL = "SELECT [PRIX_UNITE_HT] AS MONTANT " & _
             "FROM [TARIF_FOURNISSEUR]"
 
    If Len(Référence) > 0 Then
        strSQL = strSQL & " WHERE ([REF_PRODUIT] = '" & Référence & "')"
    End If

++
Minick

connexion erronne

Bonjour,

Il manque un parametre du coté du curso rlocation ligne en rouge gras

Code:

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
Sub ConnectDB(ByRef cnx As ADODB.Connection, ByVal strPath As String)
    
    'Définition du pilote de connexion
    cnx.Provider = "Microsoft.Jet.Oledb.4.0"
    'Définition de la chaîne de connexion
    cnx.ConnectionString = strPath
    'Ouverture de la base de données
    cnx.CursorLocation = adUseClient
    cnx.Open
    
End Sub
 
Public Function xretrieve(ValeurRecherche As String)
    ' Chaine de caractère : Référence du produit recherché
    Dim rst As New ADODB.Recordset, cnx As New ADODB.Connection
    
    Dim strSQL As String
    Dim strPath As String
    
    strPath = ThisWorkbook.Path & "\BDD.mdb"
    Set cnx = New ADODB.Connection
        
    ' Connexion à la base
    ConnectDB cnx, strPath
    
    'Redaction du SQL
    strSQL = "SELECT PRIX_UNITE_HT AS MONTANT FROM TARIF_FOURNISSEUR WHERE "
    strSQL = strSQL & " REF_PRODUIT = """ & ValeurRecherche & """"
    
    MsgBox strSQL
    rst.Open strSQL, cnx
    If rst.RecordCount > 0 Then
        ' Quelle Valeur ??? A prendre si doublon en ref = R12666
       While Not rst.EOF
            xretrieve = CDbl(rst("MONTANT"))
            rst.MoveNext
        Wend
    Else
        xretrieve = 0
    End If
    
    rst.Close
    Set rst = Nothing
    Exit Function
    
errH01:
    ' Nous sommes dans un tableur excel,
    '  nous ne cherchons pas à analyser les éventuelles erreurs
    '  nous rendons la main au tableur.
    Err.Clear
    xretrieve = 0
    rst.Close
    Set rst = Nothing
    
    
End Function
Sub Test()
    MsgBox xretrieve("R12666")
End Sub

J ai teste avec la base exemple sur la ref R12666 un doublon en l'occurence

REF_PRODUIT PRIX_UNITE_HT CONTRAT DATE_DEBUT DATE_FIN
R123 1 CT1 01/01/2009 00:00 31/12/2009 00:00
R125 255 CT2 01/01/2009 00:00 31/12/2009 00:00
R126 11 CT3 01/01/2009 00:00 31/12/2009 00:00
R12666 10 CT4 01/01/2009 00:00 31/12/2009 00:00
R127 550 CT5 01/01/2009 00:00 31/12/2009 00:00
R12555 2 CT6 01/01/2009 00:00 01/02/2009 00:00
R12666 3 CT4 15/05/2009 00:00 01/01/2009 00:00

Bonne continuation

1 pièce(s) jointe(s)

Re,

Merci les amis et de mon coté j'ai reussi à avancer aussi.

Voici ce que ca donne, Je vous joins ce que j'ai fait. En choisissant un numéro de contrat et en cliquant sur "Recherche", j'obtiens bien mon extraction demandé.

Simplement, j'essaye de rajouter un autre critere de choix, celui des dates. J'aimerai dire si je veux affiner ma recherche, Rentrer une date "compris entre" ou "à partir de", dans le fichier excel.
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 Sub Importe() ' Ajouter la référence Microsoft ActiveX data Objects Dim cnt As New ADODB.Connection Dim rst As New ADODB.Recordset Dim MyRange As Range Dim MaRequete As String MyContrat = Cells(4, 4).Value MyDates = Cells(6, 5).Value Application.ScreenUpdating = False Application.DisplayAlerts = False URL_BASE = ActiveWorkbook.Path & "\données.mdb" ChaineConnexion = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & URL_BASE & ";" ChaineConnexion = ChaineConnexion & "Jet OLEDB:Database Password=" & dbPassword cnt.Open ChaineConnexion MySQL = "SELECT listing.Références, listing.Prix, listing.Dates " & _ "FROM listing " & _ "WHERE (((listing.Contrats) Like '" & MyContrat & "'));" rst.Open MySQL, cnt, adOpenStatic Cells(15, 1).CopyFromRecordset rst End Sub
Merci de votre aide.

Salut,

Comme ca:

Code:

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
Sub Importe()
' Ajouter la référence Microsoft ActiveX data Objects
    Dim cnt As New ADODB.Connection
    Dim rst As New ADODB.Recordset
    Dim MaRequete As String
    Dim MyDateDeb As Date, MyDateFin As Date
 
    MyContrat = Cells(4, 4).Value
    MyDateDeb = Cells(6, 5).Value
    MyDateFin = Cells(6, 7).Value
 
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
 
    URL_BASE = ActiveWorkbook.Path & "\données.mdb"
 
    ChaineConnexion = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & URL_BASE & ";"
    ChaineConnexion = ChaineConnexion & "Jet OLEDB:Database Password=" & dbPassword
 
    cnt.Open ChaineConnexion
    MaRequete = "SELECT  listing.Références, listing.Prix, listing.Dates " & _
            "FROM listing " & _
            "WHERE listing.Contrats Like '" & MyContrat & "'"
 
    If MyDateDeb <> 0 And MyDateFin <> 0 Then
        If MyDateFin > MyDateDeb Then
            MyDateDeb = Cells(6, 7).Value
            MyDateFin = Cells(6, 5).Value
        End If
        MaRequete = MaRequete & " AND listing.dates BETWEEN " & CDbl(MyDateDeb) & " AND " & CDbl(MyDateFin)
    ElseIf MyDateDeb <> 0 Then
        MaRequete = MaRequete & " AND listing.dates >= " & CDbl(MyDateDeb)
    ElseIf MyDateFin <> 0 Then
        MaRequete = MaRequete & " AND listing.dates <= " & CDbl(MyDateFin)
    End If
 
    rst.Open MaRequete, cnt, adOpenStatic
    Cells(15, 1).CopyFromRecordset rst
End Sub

Si tu saisis la
- 1ere date : affiche tout a partir de la date
- 2eme date : affiche tout jusqu'a la date
- les 2 dates : affiche entre les 2 dates
- rien : affiche tout

++
Minick