Private Sub ConnecterClasseur(ConnectCL As Object, _
Classeur As String, _
Optional Rs)
Set ConnectCL = CreateObject("ADODB.Connection")
If Not IsMissing(Rs) Then
Set Rs = CreateObject("ADODB.Recordset")
End If
ConnectCL.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & Classeur & ";" & _
"Extended Properties=""Excel 8.0;HDR=NO;IMEX=2;"""
End Sub
Private Sub ConnecterBase(ConnectBD As Object, _
FichierBase As String, _
Optional Rs)
Set ConnectBD = CreateObject("ADODB.Connection")
If Not IsMissing(Rs) Then
Set Rs = CreateObject("ADODB.Recordset")
End If
With ConnectBD
.Provider = "Microsoft.Jet.OLEDB.4.0"
.ConnectionString = FichierBase
.Open
End With
End Sub
Private Sub Importer()
Dim ConnectClasseur As Object
Dim ConnectBase As Object
Dim Rs As Object
Dim Base As String
Dim Classeur As String
Dim NomFeuille As String
Dim SQL As String
SQL = "SELECT T1.PATNUM, T1.PATNOMP, T1.PATCONF, T2.VMDD FROM T1, T2 WHERE " & _
"T1.PATNUM=T2.PATNUM AND T2.VMDD BETWEEN #" & Format([F1], "yyyy/mm/dd") & "# AND #" & Format([F2], "yyyy/mm/dd") & "#;"
Base = "D:\Base de données1.mdb"
Classeur = "D:\Classeur2.xls"
NomFeuille = "Feuil1"
ConnecterBase ConnectBase, Base, Rs
ConnecterClasseur ConnectClasseur, Classeur
With Rs
.CursorType = 1
.LockType = 3
.Open SQL, ConnectBase
Worksheets(NomFeuille).[A1].CopyFromRecordset Rs
End With
ConnectBase.Close
ConnectClasseur.Close
Set ConnectBase = Nothing
Set ConnectClasseur = Nothing
Set Rs = Nothing
End Sub