Export CSV personnalisé
Access peut exporter les données d’une table ou d’une requête au format CSV, la méthode a d’ailleurs été présentée dans cet article du blog : Exporter une table ou une requête au format CSV.
Mais tout n’est pas personnalisable dans la méthode standard d’Access. D’où l’idée d’écrire une version plus ouverte en Visual Basic. C’est partiiii !
Le principe
Dans cet article, on va surtout poser les bases pour la suite, à savoir les classes VBA utiles. Pour structurer le code, nous aurons :
- Une classe
CSVField
qui permettra de décrire un champ CSV à exporter. En gros : son nom, son format éventuel, son titre (tout ça deviendra plus clair dans les exemples à venir !). - Une classe
CSVExport
– utilisant elle-mêmeCSVField
– qui servira de moteur d’exportation proprement dit.
Quelques préparatifs
La classe CSVExport
peut éventuellement nettoyer les liens hypertexte lors de l’exportation (ce sera illustré plus tard). Pour cela, elle utilise la fonction GetHyperlink()
traitée dans un autre article du Grenier. Reportez-vous à cet article (Nettoyer des liens hypertexte à la volée), et recopiez le code qui s’y trouve dans un module standard.
La classe CSVField
Maintenant que tout est en place :
- Créez un module de classe dans VBE (menu Insertion / Module de classe). Attention : il s’agit bien cette fois d’un module de classe, pas d’un module standard !
- Recopiez-y tout ça :
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 |
' ---------------------------------------- ' Module : CSVField ' Auteur : Hervé Inisan ' Description : Champ type pour l'export CSV. ' ---------------------------------------- Option Compare Database Option Explicit ' --- ' MEMBRES PRIVES ' --- Private m_strName As String Private m_strFormat As String Private m_strLabel As String Private m_enmCleanHyperlink As HyperlinkPrefix ' --- ' CONSTRUCTEUR ' --- Private Sub Class_Initialize() Me.CleanHyperlink = HyperlinkPrefix.none End Sub ' --- ' PROPRIETES ' --- ' Public Property Get Name() As String Name = m_strName End Property Public Property Let Name(ByVal strName As String) m_strName = strName End Property Public Property Get Format() As String Format = m_strFormat End Property Public Property Let Format(ByVal strFormat As String) m_strFormat = strFormat End Property Public Property Get Label() As String Label = m_strLabel End Property Public Property Let Label(ByVal strLabel As String) m_strLabel = strLabel End Property Public Property Get CleanHyperlink() As HyperlinkPrefix CleanHyperlink = m_enmCleanHyperlink End Property Public Property Let CleanHyperlink(ByVal enmCleanHyperlink As HyperlinkPrefix) m_enmCleanHyperlink = enmCleanHyperlink End Property |
La classe CSVExport
- Créez un deuxième module de classe.
- Recopiez-y tout ça :
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 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 |
' ---------------------------------------- ' Module : CSVExport ' Auteur : Hervé Inisan ' Description : Module d'export CSV ' ---------------------------------------- Option Compare Database Option Explicit ' --- ' MEMBRES PRIVES ' --- Private m_strSource As String Private m_strTarget As String Private m_strFieldDelimiter As String Private m_strTextDelimiter As String Private m_blnHeaders As Boolean Private m_strBooleanTrue As String Private m_strBooleanFalse As String Private m_blnExportAllFields As Boolean Private m_colFields As New Collection Private m_intHandle As Integer ' --- ' CONSTRUCTEUR / DESTRUCTEUR ' --- Private Sub Class_Initialize() Me.FieldDelimiter = ";" Me.TextDelimiter = """" Me.Headers = True Me.ExportAllFields = False End Sub Private Sub Class_Terminate() Set m_colFields = Nothing End Sub ' --- ' PROPRIETES ' --- Public Property Get Source() As String Source = m_strSource End Property Public Property Let Source(ByVal strSource As String) m_strSource = strSource End Property Public Property Get Target() As String Target = m_strTarget End Property Public Property Let Target(ByVal strTarget As String) m_strTarget = strTarget End Property Public Property Get FieldDelimiter() As String FieldDelimiter = m_strFieldDelimiter End Property Public Property Let FieldDelimiter(ByVal strFieldDelimiter As String) m_strFieldDelimiter = strFieldDelimiter End Property Public Property Get TextDelimiter() As String TextDelimiter = m_strTextDelimiter End Property Public Property Let TextDelimiter(ByVal strTextDelimiter As String) m_strTextDelimiter = strTextDelimiter End Property Public Property Get Headers() As Boolean Headers = m_blnHeaders End Property Public Property Let Headers(ByVal blnHeaders As Boolean) m_blnHeaders = blnHeaders End Property Public Property Get Fields() As Collection Set Fields = m_colFields End Property Public Property Set Fields(colFields As Collection) Set m_colFields = colFields End Property Public Property Get BooleanTrue() As String BooleanTrue = m_strBooleanTrue End Property Public Property Let BooleanTrue(ByVal strBooleanTrue As String) m_strBooleanTrue = strBooleanTrue End Property Public Property Get BooleanFalse() As String BooleanFalse = m_strBooleanFalse End Property Public Property Let BooleanFalse(ByVal strBooleanFalse As String) m_strBooleanFalse = strBooleanFalse End Property Public Property Get ExportAllFields() As Boolean ExportAllFields = m_blnExportAllFields End Property Public Property Let ExportAllFields(ByVal blnExportAllFields As Boolean) m_blnExportAllFields = blnExportAllFields End Property ' --- ' METHODES ' --- ' --- ' EXPORTATION DE LA TABLE/REQUETE ' --- ' Public Function Export() As Boolean ' Variables Dim rst As DAO.Recordset Dim intI As Integer ' Quelques vérifications... If Me.Source = "" Or Me.Target = "" Then MsgBox "La source ou la cible n'est pas définie !", vbExclamation Export = False Exit Function End If ' Est-ce que la table existe ? On Error Resume Next Dim strTable As String strTable = CurrentDb.TableDefs(Me.Source).Name If Err.Number <> 0 Then MsgBox "La table ou requête '" & Me.Source & "' est introuvable !", vbExclamation Export = False Exit Function End If ' Ouverture de la source On Error GoTo ExportErr Set rst = CurrentDb.OpenRecordset(Me.Source, dbOpenSnapshot) ' S'il faut exporter tous les champs, initialiser la liste If Me.ExportAllFields Then SetFields rst ' Création du fichier texte m_intHandle = FreeFile Open Me.Target For Output As #m_intHandle ' Exportation des en-têtes If Me.Headers Then ExportHeaders ' Exportation des enregistrements While Not rst.EOF For intI = 1 To Me.Fields.Count ExportField rst, Me.Fields(intI), intI Next ' Enregistrement suivant rst.MoveNext Wend ' Libération des ressources Export = True Close #m_intHandle rst.Close Set rst = Nothing Exit Function ExportErr: MsgBox "Erreur : " & Err.Description, vbExclamation Export = False Exit Function End Function ' --- ' EXPORTATION DES EN-TETES ' --- ' Private Sub ExportHeaders() Dim fld As CSVField Dim intI As Integer Dim strLabel As String For intI = 1 To Me.Fields.Count Set fld = Me.Fields(intI) strLabel = IIf(fld.Label = "", fld.Name, fld.Label) Print #m_intHandle, Me.TextDelimiter & strLabel & Me.TextDelimiter; EndOfLine intI Next End Sub ' --- ' EXPORTATION D'UN CHAMP ' --- ' Private Function ExportField(rst As DAO.Recordset, fld As CSVField, intIndex As Integer) Dim strVal As String ' Cas où le champ est vide If IsNull(rst(fld.Name)) Then strVal = "" Else Select Case rst(fld.Name).Type ' Nombres et dates Case dbBigInt, dbByte, dbCurrency, dbDecimal, _ dbSingle, dbDouble, dbFloat, dbNumeric, _ dbLong, dbInteger, dbDate, dbTime: strVal = Trim(Format(rst(fld.Name), fld.Format)) ' Booléens Case dbBoolean: If (Me.BooleanTrue = "") Or (Me.BooleanFalse = "") Then strVal = rst(fld.Name) Else strVal = IIf(rst(fld.Name), Me.BooleanTrue, Me.BooleanFalse) End If ' Textes Case dbChar, dbText, dbMemo If (rst(fld.Name).Attributes And dbHyperlinkField) = 0 Then ' Champ texte standard (texte ou mémo) strVal = rst(fld.Name) Else ' Lien hypertexte strVal = GetHyperlink(rst(fld.Name), fld.CleanHyperlink) End If strVal = Me.TextDelimiter & strVal & Me.TextDelimiter ' Les autres types ne sont pas exportés ' ... End Select End If Print #m_intHandle, strVal; EndOfLine intIndex End Function ' --- ' FIN DE LIGNE ' --- ' Private Sub EndOfLine(ByVal intI As Integer) If intI < Me.Fields.Count Then Print #m_intHandle, Me.FieldDelimiter; Else Print #m_intHandle, "" End If End Sub ' --- ' LISTE DES CHAMPS ' --- ' Private Sub SetFields(rst As DAO.Recordset) Dim fld As DAO.Field Dim csf As CSVField Set Me.Fields = New Collection For Each fld In rst.Fields Set csf = New CSVField csf.Name = fld.Name ' Ajouter le champ Me.Fields.Add csf, csf.Name Next End Sub |
Un petit Débogage / Compiler, pour vérifier que tout est ok.
On verra dans les prochains articles comment exploiter ces 2 classes pour obtenir une exportation CSV un peu personnalisée… Quel suspense ! 🙂
Franck > Content que ça marche ! 🙂
Re,
merci de ne pas tenir compte de mon précédent message, je viens de lire l’étape 6…
++
Franck
Merci pour l’aide.
Par contre avec exportCSV, lorsque je prends comme source uns requête,
Ce.Source = « S14_REQ »
Elle n’est pas retoruvée, je tombe en erreur ici :
Dim strTable As String
strTable = CurrentDb.TableDefs(Me.Source).Name
If Err.Number <> 0 Then
MsgBox « La table et/ou requête ‘ » & Me.Source & « ‘ est introuvable ! », vbExclamation
avec une table ne source, c’est OK.
je précise que la requête s’ouvre bien en directe.
merci de votre aide.
emi12 > Pour
HyperlinkPrefix
, il faut effectivement reprendre le code d’un article précédent (voir le paragraphe « Quelques préparatifs »). PourExportField
, il faut que la référence DAO soit également cochée (c’est le cas par défaut sur les versions récentes d’Access, mais au cas où, consulte cet article).Bonjour,
Merci pour cette article!!
Lorsque je copie/colle/compile les Classes si dessus, le compilateur me donne des erreurs sur la déclaration : Private m_enmCleanHyperlink As HyperlinkPrefix pour la classe CSVField et Private Function ExportField(rst As DAO.Recordset, fld As CSVField, intIndex As Integer) sur la deuxième.
Est-ce qu’il y a une classe ou autre à intégrer au projet Access pour utilise ce code? ou non?
Merci de votre réponse
Salutations