Export en CSV du recordset d'un formulaire

Version imprimable

Bonjour à tous

J'exporte les data de mon agenda en csv pour les importer ensuite dans google agenda.
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 Private Sub btn_TransfertCSV_Click() Dim strFilter As String Dim strInputFileName As String 'Ouvre une boite de dialogue pour demander nom et emplacement du CSV par la fonction strSaveFileName strFilter = ahtAddFilterItem(strFilter, "Csv Files (*.csv)", "*.csv") strSaveFileName = ahtCommonFileOpenSave(OpenFile:=False, Filter:=strFilter, Flags:=ahtOFN_OVERWRITEPROMPT Or ahtOFN_READONLY) DoCmd.TransferText acExportDelim, "Export_CSV", Me.Recordset, strSaveFileName, True End Sub
Je filtre par des cases à cocher dans l'en tête du formulaire les critères pour l'export. J'aimerai n'exporter que le résultat de ce filtrage. Dois-je passer par une table temporaire que je crée puis détruit ? Bien sûr le "Me.recordset" ci dessus ne fonctionne pas.
Merci d'avance pour vos suggestions.

25/04/2013, 13h56
Robert1957

Bonjour docjo,
Une solution est d'avoir une requête dans ton application qui est paramétrée selon ton formulaire et c'est elle que tu exportes.
Bonne journée

En fait, j'ai essayé de mettre des critères de date dans ma requête qui appellent des champs indépendants dans mon formulaire mais je n'y arrive pas (j'ai un post à ce sujet dans les requêtes).
Bref, j'ai fait mes critères dans le formulaire. Finalement, je suis arrivé à cette solution qui fonctionne mais je sens cela tiré par les cheveux.

Code:

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
 
Private Sub btn_TransfertCSV_Click()
 
 If Me.Form.Recordset.RecordCount > 0 Then
 
    Dim intNumOfFields As Integer
    Dim i As Integer
    Dim strBuild As String
    Dim strBuildHeader As String
    Dim strFilter As String
    Dim strSaveFileName As String
 
    'Je définis mes variables pour ouvrir une boite de dialogue par un code public qui définit le nom et le chemin du csv à créer
    strFilter = ahtAddFilterItem(strFilter, "Csv Files (*.csv)", "*.csv")
    strSaveFileName = ahtCommonFileOpenSave(OpenFile:=False, Filter:=strFilter, Flags:=ahtOFN_OVERWRITEPROMPT Or ahtOFN_READONLY)
 
    'Ouvre le fichier définit pour écrire dedant
    Open strSaveFileName For Output As #1
    Set rst = Me.Form.RecordsetClone
 
        intNumOfFields = rst.Fields.Count
 
        rst.MoveFirst
 
        With rst
            'Je commence par lister les noms des champs 
            For i = 0 To intNumOfFields - 1
                strBuildHeader = strBuildHeader & .Fields(i).Name & ","
            Next
            'Je les écris dans le csv
            Print #1, Left$(strBuildHeader, Len(strBuildHeader) - 1)
                'Je passe au valeurs elles mêmes
                Do While Not .EOF
                For i = 0 To intNumOfFields - 1
                    strBuild = strBuild & .Fields(i) & ","
                Next
                'On ecrit les valeurs à la suite des noms de champs
                Print #1, Left$(strBuild, Len(strBuild) - 1)
                strBuild = ""
                .MoveNext
                Loop
        End With
 
        rst.Close
        Set rst = Nothing
    'On ferme le fichier
    Close #1
 
    MsgBox "Fichier CSV créé avec succès!", vbInformation, "Information"
 
 Else
  MsgBox "Désolé, mais il n'y a pas d'activité à exporter!", vbInformation, "Information"
 End If

(Pour ceux qui veulent l'api d'ouverture de la boite de dialogue c'est ici)
Voilà, je sais pas si c'est catholique mais ça fonctionne. J'importe ce csv dans google agenda sans problème.
Si quelqu'un connait un code plus simple, je suis preneur.

Bonjour docjo,
Si ça fonctionne... pourquoi pas?
Si tu veux fonctionner avec une requête, en supposant que ta requête existe:

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
    Dim db As DAO.Database
    Dim qdf As DAO.QueryDef
    Dim strSQL As String
strSQL = "SELECT T_Activites.User, T_CreneauActivite.DetailCreneau AS Subject, T_Activites.DateDebutActivite AS [End Date], "_
& "T_Activites.DateDebutActivite AS [Start Date], IIf([DetailCreneau] Like "*Matin",#12/30/1899 7:0:0#, "_
& "IIf([DetailCreneau] Like '*AM',#12/30/1899 13:0:0#)) AS [Start Time], IIf([DetailCreneau] Like '*Matin',#12/30/1899 13:0:0#, "_
& "IIf([DetailCreneau] Like '*AM',#12/30/1899 18:0:0#)) AS [End Time], "FALSE" AS Private, "_
& "IIf([DetailCreneau] Not Like '*Matin' And [DetailCreneau] Not Like '*AM','TRUE','FALSE') AS [All Day Event], 'Hopital Haut Leveque' AS Location "_
& "FROM T_Activites INNER JOIN T_CreneauActivite ON T_Activites.CreneauActivite = T_CreneauActivite.CreneauActivite "_
& "WHERE (((T_Activites.User)=[Formulaires]![F_Login]![NomComplet]) AND ((T_CreneauActivite.DetailCreneau) Is Not Null) "_
& "AND ((T_Activites.DateDebutActivite)>=" & DatePourSql([Formulaires]![F_PraticienActivites]![DateDepart]) & "));"
    Set db = CurrentDb
    Set qdf = db.QueryDefs("LeNomDeTaRequête")
    qdf.SQL = strSQL
    Set qdf = Nothing
    Set db = Nothing
 
 
Function DatePourSql(xDate)
    DatePourSql = "#" & Month(xDate) & "-" & Day(xDate) & "-" & Year(xDate) & "#"
End Function

Et tu remplaces Me.Recordset par le nom de ta requête.
Bonne journée

26/04/2013, 07h23
docjo

Merci pour la fonction de la date. Mais je ne comprends pas pourquoi un Cdate ou la simple mise entre # ne suffit pas. Les mystères d'access ou ceux du SQL ?
26/04/2013, 14h51
Robert1957

Bonjour docjo,
Pour ce qui est de la fonction pour la date, dans le passé je ne me servais pas de cette fonction. Dans une discussion ici j'ai répondu à quelqu'un qui avait des problèmes de dates. Un des experts(j'ai oublié qui) a corrigé mon code en insérant cette fonction. Je lui ai demandé pourquoi et selon lui Access ne fait pas toujours la bonne chose. Difficile pour moi de vérifier parce que je formate mes champs dates "YYYY-mm-dd" et Access fait bien la conversion pour du SQL en "mm-jj-YYYY" qui est la norme SQL, mais depuis je ne prend pas de chance.
Bonne journée