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 55 56 57 58 59
| Sub Test()
ExtractionDonnees_VersTXT _
ThisWorkbook.FullName, _
"Feuil1", _
"A1:C12", _
"Champ1", _
"Ville 02", _
"C:\essai.txt"
End Sub
Sub ExtractionDonnees_VersTXT(WbSource As String, WsSource As String, PlageSource As String, _
ChampFiltre As String, ValeurChamp As String, Chemin_et_NomFichierTXT)
Dim objCn As Object, Rst As Object
Dim x As String
Dim i As Long
WsSource = WsSource & "$"
'Connection à la source de données
Set objCn = CreateObject("ADODB.Connection")
objCn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & WbSource & _
";Extended Properties=""Excel 8.0;HDR=YES;"";"
'Création recordset/requete dans la base de données
Set Rst = objCn.Execute("SELECT * FROM [" & WsSource & PlageSource & "] WHERE " & _
ChampFiltre & "='" & ValeurChamp & "'")
'Si le la requete fournit un résultat :
If Not Rst.EOF Then
'--- récupération de la première ligne (en-têtes)
For i = 0 To Rst.Fields.Count - 1
x = x & Rst.Fields(i).Name & ";"
Next i
'---
'Création du fichier txt.
'Si le fichier existe, les anciennes données seront écrasées.
'Si le fichier n'existe pas , il sera créé automatiquement.
Open Chemin_et_NomFichierTXT For Output As #1
'Ecriture de l'entête dans le fichier .txt
Print #1, Left(x, Len(x) - 1) & vbCrLf;
'Ecriture de la requête dans le fichier .txt
' 2 (adClipString) indique le format de la requête (choix unique).
' -1 indique qu'il faut récupérer tous les enregistrements.
' ";" spécifie le délimiteur de colonnes.
' vbCrLf spécifie le délimiteur d'enregistrements.
' "" indique comment doivent être représentées les valeurs nulles.
Print #1, Rst.GetString(2, -1, ";", vbCrLf, "")
Close #1
End If
Rst.Close
objCn.Close
Set Rst = Nothing
Set objCn = Nothing
End Sub |
Partager