Sub Import2()
' Cette démo exige une référence à la
' biliothèque Microsoft ActiveX Data Objects 2.x
Dim DBFullName As String
Dim Cnct As String, Src As String, test As String
Dim Connection As ADODB.Connection
Dim Recordset As ADODB.Recordset
Dim Col As Integer
' Information de base de données
DBFullName = ThisWorkbook.Path & "\Ma_Base_2006.mdb"
' Ouverture de la connexion
Set Connection = New ADODB.Connection
Cnct = "Provider=Microsoft.Jet.OLEDB.4.0; "
Cnct = Cnct & "Data Source=" & DBFullName & ";"
Connection.Open ConnectionString:=Cnct
' Création du jeu d'enregistrement
Set Recordset = New ADODB.Recordset
With Recordset
' Filtrage
Src = "SELECT * FROM & Base Machines WHERE Valider = 'x'"
.Open Source:=Src, ActiveConnection:=Connection
' Ecriture des noms de champs
For Col = 0 To Recordset.Fields.Count - 1
Range("C1").Offset(0, Col).Value = _
Recordset.Fields(Col).Name
Next
' Ecriture du jeu d'enregistrement
Range("C1").Offset(1, 0).CopyFromRecordset Recordset
End With
Set Recordset = Nothing
Connection.Close
Set Connection = Nothing
End Sub