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 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54
| Sub EssaiSELECT()
'Connection à la base de données sur le serveur afin d'en extraire des données à jour _
et les tranférer dans le fichier utilisateur
Dim DateDepart As Date, DateFin As Date
Dim MatUtil As String
Dim NomFeuille As String
Dim Cn As ADODB.Connection
Dim Fichier As String
Dim NomFeuille As String, texte_SQL As String
Dim Rst As ADODB.Recordset
'Définir le classeur fermé servant de base de données avec le chemin réseau
' Chemin pour essai à supprimer
MatUtil = Environ("USERNAME")
Fichier = "D:\Donnees\" & MatUtil & "\Mes documents\BaseEssaiSELECT.xls"
'Nom de la feuille dans le classeur fermé
NomFeuille = "BdD"
'Partie pour essai parametrage requête, A SUPPRIMER
ThisWorkbook.Sheets("Feuil1").Select
DateDepart = Sheets("Feuil1").Cells(1, 1).Value
DateFin = Sheets("Feuil1").Cells(1, 2).Value
'--------------------------------------------------------
Set Cn = New ADODB.Connection
'--- Connection ---
With Cn
.Provider = "Microsoft.Jet.OLEDB.4.0"
.ConnectionString = "Data Source=" & Fichier & _
";Extended Properties=Excel 8.0;"
.Open
End With
'-----------------
'Définition de la requête.
texte_SQL = "SELECT Organisme,Contact,Date_Deb,Date_Fin-Date_Deb AS Periode,Tel,Port,mail FROM [" & NomFeuille & "$] WHERE Date_Fin >" & DateDepart & " AND Date_Fin <" & DateFin & " ORDER BY 1"
Set Rst = New ADODB.Recordset
Set Rst = Cn.Execute(texte_SQL)
'Ecrit le résultat de la requête dans la cellule A2 de la feuille du fichier utilisateur
Sheets(1).Select
Range("A2").CopyFromRecordset Rst
'--- Fermeture connexion ---
Cn.Close
Set Cn = Nothing
End Sub |
Partager