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
| Sub Importe()
' Ajouter la référence Microsoft ActiveX data Objects
Dim cnt As New ADODB.Connection
Dim rst As New ADODB.Recordset
Dim MaRequete As String
Dim MyDateDeb As Date, MyDateFin As Date
MyContrat = Cells(4, 4).Value
MyDateDeb = Cells(6, 5).Value
MyDateFin = Cells(6, 7).Value
Application.ScreenUpdating = False
Application.DisplayAlerts = False
URL_BASE = ActiveWorkbook.Path & "\données.mdb"
ChaineConnexion = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & URL_BASE & ";"
ChaineConnexion = ChaineConnexion & "Jet OLEDB:Database Password=" & dbPassword
cnt.Open ChaineConnexion
MaRequete = "SELECT listing.Références, listing.Prix, listing.Dates " & _
"FROM listing " & _
"WHERE listing.Contrats Like '" & MyContrat & "'"
If MyDateDeb <> 0 And MyDateFin <> 0 Then
If MyDateFin > MyDateDeb Then
MyDateDeb = Cells(6, 7).Value
MyDateFin = Cells(6, 5).Value
End If
MaRequete = MaRequete & " AND listing.dates BETWEEN " & CDbl(MyDateDeb) & " AND " & CDbl(MyDateFin)
ElseIf MyDateDeb <> 0 Then
MaRequete = MaRequete & " AND listing.dates >= " & CDbl(MyDateDeb)
ElseIf MyDateFin <> 0 Then
MaRequete = MaRequete & " AND listing.dates <= " & CDbl(MyDateFin)
End If
rst.Open MaRequete, cnt, adOpenStatic
Cells(15, 1).CopyFromRecordset rst
End Sub |
Partager