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
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
| Option Explicit
Public Type TypeElementTableStr
BDD As String
Table As String
Colonne As String
Element As String
End Type
Function RechercheUnElementString(ByRef MonElementStr As TypeElementTableStr) As Collection
'recherche un element dans la BDD et renvoie la première ligne associée
'tous les elements de la BDD doivent être de type string
'Elements entrant :
'BDD = location de la BDD (ex : c:\toto.mdb")
'Table = nom de la table dans laquel on veut faire la recherche
'Colonne = Nom de la colonne dans laquel on veut faire la recherche
'Element = chaine de caractère à rechercher
Dim MaRequete As String
Dim MonRecordset As ADODB.Recordset
Dim MaConnexion As New ADODB.Connection
Dim i As Integer
Dim MonMessageErreur As String
MaRequete = "SELECT * FROM " & MonElementStr.Table & " WHERE " & MonElementStr.Colonne & "='" & MonElementStr.Element & "'"
Set MonRecordset = New ADODB.Recordset
Set MaConnexion = New ADODB.Connection
On Error GoTo RechercheUnElementFin
Set RechercheUnElementString = New Collection
'Définition du pilote de connexion (fournisseur)
MaConnexion.Provider = "Microsoft.Jet.Oledb.4.0"
'Définition de la chaîne de connexion : chemin complet du .mdb
MaConnexion.ConnectionString = MonElementStr.BDD
'Ouverture de la base de données
MaConnexion.Open "Data Source=" & MonElementStr.BDD
MonRecordset.Open MaRequete, MaConnexion
If MonRecordset.EOF And MonRecordset.EOF Then
MsgBox "Element introuvable !"
Else
'affiche l'element recherché
For i = 0 To MonRecordset.Fields.Count - 1
RechercheUnElementString.Add MonRecordset(i).Value
Next i
MsgBox MonRecordset.RecordCount
End If
MonRecordset.Close
Set MonRecordset = Nothing
MaConnexion.Close
Set MaConnexion = Nothing
On Error GoTo 0
Exit Function
RechercheUnElementFin:
MonMessageErreur = "BDD : " & MonElementStr.BDD & vbCr & _
"Table : " & MonElementStr.Table & vbCr & _
"Colonne : " & MonElementStr.Colonne & vbCr & _
"Element recherché : " & MonElementStr.Element & vbCr
MonMessageErreur = MonMessageErreur & vbCr & Err.Description
On Error GoTo 0
MsgBox MonMessageErreur
End Function
Sub main()
Dim MonElementStr As TypeElementTableStr
Dim MaCollection As New Collection
Dim MaChaine As String
Dim Element As Variant
MonElementStr.Element = "Réf2"
MonElementStr.BDD = "c:\echange\bd1.mdb"
MonElementStr.Table = "Essai"
MonElementStr.Colonne = "Reference"
Set MaCollection = RechercheUnElementString(MonElementStr)
If Not (MaCollection.Count = 0) Then
For Each Element In MaCollection
MaChaine = MaChaine & Element & vbCr
Next Element
MsgBox (MaChaine)
End If
End Sub |
