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
| Option Explicit
'--- activer les références:
'--- Microsoft ActiveX Data Objects
'--- Microsoft ActiveX Data Objects Recordset
Sub ListerNoms()
Dim xlcon As ADODB.Connection
Dim xlrs As ADODB.Recordset
Dim nextRow As Integer
Dim sLeNom As String
'---
Set xlcon = New ADODB.Connection
Set xlrs = New ADODB.Recordset
sLeNom = Range("D5").Value
Range("D5").Value = UCase(sLeNom) '--- force la mise en majuscules
sLeNom = Range("D5").Value
'---
xlcon.Provider = "Microsoft.ACE.OLEDB.12.0"
xlcon.ConnectionString = "Data Source=" & ThisWorkbook.Path & ";Extended Properties=""text;HDR=Yes;FMT=Delimited"""
xlcon.Open
xlrs.Source = "SELECT * FROM [tout.csv] WHERE nomprenom LIKE '" & sLeNom & "%'"
xlrs.Open xlrs.Source, xlcon, adOpenStatic, adLockReadOnly
'---
If xlrs.PageCount = 0 Then
MsgBox "Aucun résultat", , "Pour info"
Else
xlrs.MoveFirst
Worksheets("Extraits").Select
nextRow = Cells(Rows.Count, 1).End(xlUp).Row + 1
Worksheets("Extraits").Cells(nextRow, 1).CopyFromRecordset xlrs
End If
xlrs.Close
xlcon.Close
Set xlrs = Nothing
Set xlcon = Nothing
DeleteConnections
End Sub
Sub DeleteConnections()
Dim Conn As Object
For Each Conn In ThisWorkbook.Connections
Debug.Print Conn.Name
Conn.Delete
Next Conn
End Sub |
Partager