' Penser à cocher : Microsoft ActiveX Data Object 2.6
' Dans Outils -> Références
Sub RecupDonnees()
Dim VPath As String, FicBdD As String
Dim Cn, rs As ADODB.Recordset
Dim Mabdd As String, Crit As String
Dim DerLig as Long
' En cas d'erreur
On Error GoTo Err_Proc
' Initialisation des variables
VPath = ActiveWorkbook.Path ' Chemin d'accès de la BdD
FicBdD = "donnees_dossiers.xls" ' Fichier contenant la BdD
Mabdd = "[Interactions$A1:AH65536]" ' Feuille et Plage contenant les données
' Pour les dates il faut inverser le jour et le mois = format US
' Dans l'exemple seulement les dates supérieures au 09/03, sachant que tu as des heures
Crit = "[Date ouverture]>#03/10/2009#" ' Critères de sélection des enregistrements
' Créer la Connexion ADO
Set Cn = New ADODB.Connection
' Ouvrir la BdD
Cn.Open "DRIVER={Microsoft Excel Driver (*.xls)};DBQ=" & VPath & "\" & FicBdD
' Ouvrir les enregistrements selon le criètère
Set rs = Cn.Execute("SELECT * FROM " & Mabdd & " where " & Crit)
' Copier les enregistrements correspondants en A2
With ThisWorkbook.Sheets("Interactions")
' Effacer le contenu des cellules avant l'import
DerLig = .Range("A" & Rows.Count).End(xlUp).Row
.Range("A2:AH" & DerLig).ClearContents
' Importer les enregistrements
.Range("A2").CopyFromRecordset rs
End With
Err_Proc:
rs.Close
Set rs = Nothing
Cn.Close
Set Cn = Nothing
End Sub