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 60 61 62 63 64 65 66 67 68 69 70
| Sub RequeteDansCsv()
Dim SourceODBC As String
Dim TexteRequete As String
Dim CompA As Long
SourceODBC = "ODBC;DSN=Base Clip CMIE4;;ANA=C:\PROGRAM FILES\CLIPPER 4\WCLIP.WD7\WCLIP.WDD;;REP=U:\FICHIERS\CMIE\;"
TexteRequete = "Select POINT.NAF, POINT.GACLEUNIK, POINT.CODEEMP, POINT.TPSPASSE, POINT.DAT, POINT.COFRAIS, EMPLOYE.NOMEMP, EMPLOYE.PRENOMEMP " & _
"From EMPLOYE, POINT Where EMPLOYE.CODEEMP = POINT.CODEEMP And ((POINT.NAF>10000)) " & _
"Order by POINT.CODEEMP, POINT.DAT, POINT.COFRAIS"
'----------------------- requêtes via Query
' Dim Connection As QueryTable
' Cells.ClearContents
'Set Connection = ActiveSheet.QueryTables.Add(Connection:=SourceODBC, _
' Destination:= Range("A1"), Sql:=TexteRequete)
'Connection.Refresh
'-----------------------
'----------------------- requêtes Avec Reference Microsoft DAO 3.6 Object Library
Dim Donnees As DAO.Database
Dim Requete As Recordset
Set Donnees = DAO.OpenDatabase(SourceODBC, False, False, SourceODBC)
Set Requete = Donnees.OpenRecordset(TexteRequete, DAO.dbOpenSnapshot)
'-----------------------Récupération du résultat dans Excel
' Dim Cellule As Range
'Cells.ClearContents
'Set Cellule = Range("A1")
'For CompA = 0 To Requete.Fields.Count - 1
' Cellule.Offset(0, CompA).Value = Requete.Fields(CompA).Name
'Next CompA
'Range("A2").CopyFromRecordset Requete
'-----------------------
'-----------------------Récupération dans Fichier Texte
Dim Appli As Object
Dim Creation As Object
Dim Ouverture As Object
Dim Enregistrement As String
Set Appli = CreateObject("Scripting.FileSystemObject")
On Error GoTo A:
Set Creation = Appli.CreateTextFile("U:\ETAT_JPC_CLIPPER\Information\Point.csv", True)
A:
Enregistrement = Requete.Fields(0).Name recuperation des noms de champs
For CompA = 1 To Requete.Fields.Count - 1
Enregistrement = Enregistrement & ";" & Trim(Requete.Fields(CompA).Name)
Next CompA
Creation.Write Enregistrement & vbCrLf
Do While Not (Requete.EOF)
Enregistrement = Trim(Requete.Fields(0).Value)
For CompA = 1 To Requete.Fields.Count - 1
If CompA = 2 Then
Enregistrement = Enregistrement & ";_" & Trim(Requete.Fields(CompA).Value) 'ajout du _ pour code employe
Else
Enregistrement = Enregistrement & ";" & Trim(Requete.Fields(CompA).Value)
End If
Next CompA
Creation.Write Enregistrement & vbCrLf
Requete.MoveNext
Loop
'-----------------------
Creation.Close
Requete.Close
Donnees.Close
Set Requete = Nothing
Set Donnees = Nothing
End Sub |
Partager