Sub RecupDonnees()
Dim VPath As String, FicBdD As String
Dim Cn, rs As ADODB.Recordset
Dim Mabdd As String, Crit As String, Crit2 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
Fic = ThisWorkbook.Name
FicBdD = "donnees_dossiers BIS.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
Crit = Workbooks(Fic).Sheets("Outils").Range("C2").Value
Crit2 = Workbooks(Fic).Sheets("Outils").Range("D2").Value
Cri = Format(Crit, "mm/dd/yyyy")
Cri2 = Format(Crit2, "mm/dd/yyyy")
Crit = "[Date ouverture]>#" & Cri & "#"
Crit2 = "[Date Clôture]<#" & Cri2 & "#"
' 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) '& " where " & Crit2)
' Inscrire le nom de chaque champ
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
' Copier les enregistrements correspondants en A2
For NbChamp = 0 To rs.Fields.Count - 1
.Range("A1").Offset(0, NbChamp).Value = rs.Fields(NbChamp).Name
Next NbChamp
' Importer les enregistrements
.Range("A2").CopyFromRecordset rs
' Mettre certaines colonnes au bon format
.Range("V:Y").NumberFormat = "[h]:mm:ss"
End With
'************************************************************
Mabdd = "[Incidents$A1:AS65536]"
'Crit = "[Date ouverture]>#03/10/2009#"
Set rs = Cn.Execute("SELECT * FROM " & Mabdd & " where " & Crit)
With ThisWorkbook.Sheets("Incidents")
DerLig = .Range("A" & Rows.Count).End(xlUp).Row
.Range("A1:AS" & DerLig).ClearContents
For NbChamp = 0 To rs.Fields.Count - 1
.Range("A1").Offset(0, NbChamp).Value = rs.Fields(NbChamp).Name
Next NbChamp
.Range("A2").CopyFromRecordset rs
' Mettre certaines colonnes au bon format
.Range("AA2:AB" & DerLig).NumberFormat = "[h]:mm:ss"
.Range("AJ2:AK" & DerLig).NumberFormat = "[h]:mm:ss"
End With
rs.Close
Set rs = Nothing
Cn.Close
Set Cn = Nothing
Err_Proc:
End Sub