Mise à jour d’une base Access par fichier CSV ou Excel – Episode 2
Aujourd’hui, voici un (gros) bout de code VBA qui va nous servir à automatiser l’importation de fichiers CSV ou Excel dans une base de données Access.
Si vous avez manqué le début
Relisez l’article suivant, si vous venez d’arriver sur cette page sans frapper… 😉
Préparation de votre base
Votre base de données Access doit comporter quelques réglages pour que tout ce qui suit fonctionne :
- Activez la bibliothèque DAO dans le menu Outils / Références de Visual Basic Editor. Pour plus de détails, consultez cet article.
- Recopiez également la fonction
StringFormat(), que vous trouverez sur cette page du site self-access.com. Sur la page citée, recopiez le premier bloc de code (les autres sont des exemples d’utilisation, pas utiles ici).
La classe TableUpdater
Voici le code qui va gérer l’importation d’un fichier externe (CSV ou Excel) dans une table Access. Tout ce code doit être recopié dans un module de classe. Voici comment faire :
- Ouvrez votre base Access.
- Activez l’onglet Créer du ruban.
- Tout à droite, cliquez sur Module de classe.
- Recopiez tout le bazar qui suit (!) dans le module vide obtenu.
- Enregistrez le module, en lui donnant le nom
TableUpdater.
|
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 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347 348 349 350 351 352 353 354 355 356 357 358 359 360 361 362 363 364 365 366 367 368 369 370 371 372 373 374 375 376 377 378 379 380 381 382 383 384 385 386 387 388 389 390 391 392 393 394 395 396 397 398 399 400 401 402 403 404 405 406 407 408 409 410 411 412 413 414 415 416 417 418 419 420 421 422 423 424 425 426 427 428 429 430 431 432 433 434 435 436 437 438 439 440 441 442 443 444 445 446 |
' ---------------------------------------- ' Module : TableUpdater ' Auteur : Hervé Inisan ' Description : Classe d'import CSV/Excel. ' Cette classe importe un seul fichier CSV ou Excel ' dans une seule table Access. ' ---------------------------------------- Option Compare Database Option Explicit ' --- ' LISTE DES TYPES DE SOURCES DE DONNEES ' --- Public Enum SourceTypes Csv = 0 Excel = 1 End Enum ' --- ' CONSTANTES ' --- Private Const UPDATE_QUERY As String = "rqt Import TEMP" ' --- ' MEMBRES PRIVES ' --- Private m_strSource As String Private m_strRange As String Private m_stSourceType As SourceTypes Private m_sstExcelVersion As AcSpreadSheetType Private m_strTempTable As String Private m_strTarget As String Private m_blnHeaders As String Private m_strImportSpecs As String Private m_ieLastError As ImportError Private m_lngInsertedRows As Long Private m_lngUpdatedRows As Long Private m_blnAutoClean As Boolean ' --- ' CONSTRUCTEUR / DESTRUCTEUR ' --- Private Sub Class_Initialize() Me.Headers = True Me.AutoClean = True Me.SourceType = Csv Me.ExcelVersion = acSpreadsheetTypeExcel12 End Sub ' --- ' PROPRIETES ' --- Public Property Let Source(ByVal strSource As String) m_strSource = strSource End Property Public Property Get Source() As String Source = m_strSource End Property Public Property Let Range(ByVal strRange As String) m_strRange = strRange End Property Public Property Get Range() As String Range = m_strRange End Property Public Property Let SourceType(ByVal stSourceType As SourceTypes) m_stSourceType = stSourceType End Property Public Property Get SourceType() As SourceTypes SourceType = m_stSourceType End Property Public Property Let ExcelVersion(ByVal sstExcelVersion As AcSpreadSheetType) m_sstExcelVersion = sstExcelVersion End Property Public Property Get ExcelVersion() As AcSpreadSheetType ExcelVersion = m_sstExcelVersion End Property Public Property Let TempTable(ByVal strTempTable As String) m_strTempTable = strTempTable End Property Public Property Get TempTable() As String TempTable = m_strTempTable End Property Public Property Let Target(ByVal strTarget As String) m_strTarget = strTarget ' Nom par défaut de la table temporaire d'importation If Me.TempTable = "" Then Me.TempTable = strTarget & " - IMPORT" End If End Property Public Property Get Target() As String Target = m_strTarget End Property Public Property Get PrimaryKey() As String On Error Resume Next PrimaryKey = CurrentDb.TableDefs(Me.Target).Indexes("PrimaryKey").Fields(0).Name If Err.Number <> 0 Then PrimaryKey = "" End Property Public Property Let Headers(ByVal blnHeaders As Boolean) m_blnHeaders = blnHeaders End Property Public Property Get Headers() As Boolean Headers = m_blnHeaders End Property Public Property Let ImportSpecs(ByVal strImportSpecs As String) m_strImportSpecs = strImportSpecs End Property Public Property Get ImportSpecs() As String ImportSpecs = m_strImportSpecs End Property Public Property Get LastError() As ImportError Set LastError = m_ieLastError End Property Private Function SetLastError(ByVal info As ImportInfo) As ImportInfo Set m_ieLastError = New ImportError m_ieLastError.Number = info SetLastError = info End Function Public Property Get AutoClean() As Boolean AutoClean = m_blnAutoClean End Property Public Property Let AutoClean(ByVal blnAutoClean As Boolean) m_blnAutoClean = blnAutoClean End Property Public Property Get InsertedRows() As Long InsertedRows = m_lngInsertedRows End Property Public Property Get UpdatedRows() As Long UpdatedRows = m_lngUpdatedRows End Property ' --- ' VERIFICATION DES PARAMETRES ' --- ' Public Function Check() As ImportInfo Dim strTableName As String If (Me.Source = "") Then Check = SetLastError(SourceNotFound) Exit Function End If If Dir(Me.Source) = "" Then Check = SetLastError(SourceNotFound) Exit Function End If If (Me.PrimaryKey = "") Then Check = SetLastError(PrimaryKeyNotDefined) Exit Function End If If (Me.Target = "") Then Check = SetLastError(TargetNotFound) Exit Function End If If (Me.TempTable = "") Then Check = SetLastError(TempTableNotDefined) Exit Function End If On Error Resume Next strTableName = CurrentDb.TableDefs(Me.Target).Name If Err.Number <> 0 Then Check = TargetNotFound End If Check = SetLastError(NoError) End Function ' --- ' METHODES ' --- ' --- ' IMPORT COMPLET ' --- ' Note : Cette méthode est la méthode principale ' de la classe TableUpdater. C'est elle qui ' gère les différentes étapes du processus ' d'importation. ' Sub Import() ' Est-ce que tous les paramètres sont valides ? If Me.Check() <> NoError Then Exit Sub ' Importation du fichier texte If ImportFile() <> NoError Then Exit Sub ' Mise à jour des enregistrements existants UpdateData If Me.LastError.Number <> NoError Then Exit Sub ' Ajout des nouveaux enregistrements m_lngInsertedRows = 0 InsertData blnIncludeKey:=True If Me.LastError.Number <> NoError Then Exit Sub ' Cas particulier des clefs primaires auto-incrémentées InsertData blnIncludeKey:=False ' Nettoyage des objets temporaires If Me.AutoClean Then Me.Clean End Sub ' --- ' IMPORTATION DU FICHIER CSV ' --- ' Private Function ImportFile() As ImportInfo ' Destruction de la table temporaire On Error Resume Next CurrentDb.TableDefs.Delete Me.TempTable ' Importation du fichier externe dans la table temporaire Err.Clear If Me.SourceType = Csv Then ' Fichier texte DoCmd.TransferText acImportDelim, Me.ImportSpecs, Me.TempTable, Me.Source, Me.Headers Else ' Fichier Excel DoCmd.TransferSpreadsheet acImport, Me.ExcelVersion, Me.TempTable, Me.Source, Me.Headers, Me.Range End If ImportFile = SetLastError(IIf(Err.Number = 0, NoError, ImportError)) End Function ' --- ' AJOUT DES NOUVEAUX ENREGISTREMENTS ' --- ' Private Function InsertData(ByVal blnIncludeKey As Boolean) Dim db As DAO.Database Dim strSQL As String ' Instruction SQL strSQL = "INSERT INTO [{0}] ({3}) SELECT {3} FROM [{1}]" _ & " WHERE ([{2}] NOT IN (SELECT [{2}] FROM [{0}]))" If blnIncludeKey Then strSQL = strSQL & " AND ([{2}] > 0)" Else strSQL = strSQL & " AND ([{2}] < 1)" End If strSQL = StringFormat(strSQL, _ Me.Target, _ Me.TempTable, _ Me.PrimaryKey, _ InsertFields(blnIncludeKey)) ' Insertion des enregistrements On Error Resume Next Err.Clear Set db = CurrentDb db.Execute strSQL If Err.Number = 0 Then m_lngInsertedRows = m_lngInsertedRows + db.RecordsAffected SetLastError NoError Else SetLastError InsertError End If Set db = Nothing End Function ' --- ' MISE A JOUR DES ENREGISTREMENTS EXISTANTS ' --- ' Private Function UpdateData() Dim strSQL As String Dim db As DAO.Database Dim rst As DAO.Recordset Dim qdf As DAO.QueryDef Dim fld As DAO.Field ' Construire la requête de mise à jour BuildUpdateQuery If Me.LastError.Number <> NoError Then Exit Function ' Chaîne SQL pour l'extraction des lignes de mises à jour strSQL = StringFormat( _ "SELECT * FROM [{1}]" _ & " WHERE [{2}] IN (SELECT [{2}] FROM [{0}])", _ Me.Target, _ Me.TempTable, _ Me.PrimaryKey) ' Requête paramétrée de mise à jour Set db = CurrentDb Set qdf = db.QueryDefs(UPDATE_QUERY) ' Appliquer les mises à jour m_lngUpdatedRows = 0 On Error GoTo UpdateErr Set rst = db.OpenRecordset(strSQL, dbOpenSnapshot) While Not rst.EOF ' Alimenter les paramètres de la requête de mise à jour For Each fld In rst.Fields qdf.Parameters("p_" & fld.Name).Value = rst(fld.Name) Next ' Exécuter la mise à jour qdf.Execute dbFailOnError m_lngUpdatedRows = m_lngUpdatedRows + 1 ' Enregistrement suivant rst.MoveNext Wend qdf.Close rst.Close Set qdf = Nothing Set rst = Nothing Set db = Nothing ' Terminé ! SetLastError NoError Exit Function UpdateErr: m_lngUpdatedRows = 0 SetLastError InsertError Exit Function End Function ' --- ' LISTE DE CHAMPS POUR LE INSERT INTO ' --- ' Private Function InsertFields(ByVal blnIncludeKey As Boolean) Dim db As DAO.Database Dim tdf As DAO.TableDef Dim qdf As DAO.QueryDef Dim fld As DAO.Field Dim strSQL As String Set db = CurrentDb Set tdf = db.TableDefs(Me.TempTable) ' Liste des champs strSQL = "" For Each fld In tdf.Fields If (fld.Name <> Me.PrimaryKey) Or blnIncludeKey Then If strSQL <> "" Then strSQL = strSQL & ", " strSQL = strSQL & "[" & fld.Name & "]" End If Next Set tdf = Nothing InsertFields = strSQL End Function ' --- ' CONSTRUCTION DE LA REQUETE DE MISE A JOUR ' --- ' Private Function BuildUpdateQuery() Dim db As DAO.Database Dim tdf As DAO.TableDef Dim qdf As DAO.QueryDef Dim fld As DAO.Field Dim strSQL As String On Error GoTo UpdateErr strSQL = "" Set db = CurrentDb Set tdf = db.TableDefs(Me.TempTable) ' Partie SET de la requête (liste des champs à mettre à jour) For Each fld In tdf.Fields If fld.Name <> Me.PrimaryKey Then If strSQL <> "" Then strSQL = strSQL & ", " strSQL = strSQL & StringFormat("[{0}] = [p_{0}]", fld.Name) End If Next Set tdf = Nothing ' Chaîne SQL finale strSQL = StringFormat( _ "UPDATE [{0}] SET " & strSQL _ & " WHERE [{1}] = [p_{1}]", _ Me.Target, _ Me.PrimaryKey) ' Créer une requête On Error Resume Next Set qdf = db.QueryDefs(UPDATE_QUERY) If Err.Number = 0 Then qdf.SQL = strSQL Else Set qdf = db.CreateQueryDef(UPDATE_QUERY, strSQL) End If ' Libérer les ressources qdf.Close Set qdf = Nothing Set db = Nothing SetLastError NoError Exit Function UpdateErr: SetLastError UnknownError Exit Function End Function ' --- ' SUPPRESSION DES OBJETS TEMPORAIRES ' --- ' Public Sub Clean() On Error Resume Next ' Supprimer la table temporaire CurrentDb.TableDefs.Delete Me.TempTable ' Supprimer la requête de mise à jour CurrentDb.QueryDefs.Delete UPDATE_QUERY End Sub |
La classe ImportError
Pour que les erreurs d’importation soient diagnostiquées clairement, il vous faut encore une autre classe VBA. Comme plus haut :
- Activez l’onglet Créer du ruban.
- Tout à droite du ruban, cliquez sur Module de classe.
- Recopiez ce qui suit dans le module vide obtenu.
- Enregistrez le module, en lui donnant le nom ImportError.
|
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 |
' ---------------------------------------- ' Module : ImportError ' Auteur : Hervé Inisan ' Description : Erreurs d'importation. ' ---------------------------------------- Option Compare Database Option Explicit ' --- ' LISTE DES ERREURS POSSIBLES ' --- Public Enum ImportInfo NoError = 0 SourceNotFound = 1 TargetNotFound = 2 PrimaryKeyNotDefined = 3 TempTableNotDefined = 4 ImportError = 5 InsertError = 6 UpdateError = 7 UnknownError = 8 End Enum ' --- ' TRADUCTION DES ERREURS D'IMPORTATION ' --- Const IMPORT_NOERROR As String = "Aucune erreur" Const IMPORT_SOURCENOTFOUND As String = "Fichier source introuvable" Const IMPORT_TARGETNOTFOUND As String = "Table cible introuvable" Const IMPORT_PRIMARYKEYNOTDEFINED As String = "Clef primaire non définie" Const IMPORT_TEMPTABLENOTDEFINED As String = "Table temporaire non définie" Const IMPORT_IMPORTERROR As String = "Erreur d'importation" Const IMPORT_INSERTERROR As String = "Erreur lors de l'insertion de lignes" Const IMPORT_UPDATEERROR As String = "Erreur lors de la mise à jour de lignes" Const IMPORT_UNKNOWNERROR As String = "Erreur inconnue" ' --- ' MEMBRES PRIVES ' --- Private m_infError As ImportInfo ' --- ' PROPRIETES ' --- ' --- ' NUMERO DE L'ERREUR ' --- ' Public Property Let Number(ByVal infError As ImportInfo) m_infError = infError End Property Public Property Get Number() As ImportInfo Number = m_infError End Property ' --- ' INTITULE DE L'ERREUR ' --- ' Public Property Get Label() As String Select Case Me.Number Case NoError: Label = IMPORT_NOERROR Case SourceNotFound: Label = IMPORT_SOURCENOTFOUND Case TargetNotFound: Label = IMPORT_TARGETNOTFOUND Case PrimaryKeyNotDefined: Label = IMPORT_PRIMARYKEYNOTDEFINED Case TempTableNotDefined: Label = IMPORT_TEMPTABLENOTDEFINED Case ImportError: Label = IMPORT_IMPORTERROR Case InsertError: Label = IMPORT_INSERTERROR Case UpdateError: Label = IMPORT_UPDATEERROR Case UnknownError: Label = IMPORT_UNKNOWNERROR End Select End Property |
Comment ça marche ?
Vu la longueur du code VBA ci-dessus (près de 550 lignes), je détaillerai son fonctionnement dans un prochain article. Quel suspense, non ?! 🙂
Info
Lorsque la série d’articles sera terminée, je posterai dans la section Téléchargements du blog une base de données complète reprenant tous les exemples.
Bonjour,
Tout d’abord merci pour l’article!
Mais j’ai deja un petit souci…En voulant activer la bibliotheque DAO. Je coche la case MicrosoftDAO 3.6 Object Library et en cliquant sur OK la fenetre suivante s’ouvre :
« Name conflicts with existing module, project, or object library »
Savez vous pourquoi?
Cordialement
De quelle version d’Access s’agit-il ?
Bonjour.
Un grand bravo pour cette article
Il serait bien d’ajouter ce code si nous voulons importer un fichier avec une version d’Excel dépassé (2003)
« acSpreadsheetTypeExcel9 »
Quand pensez-vous ?
Merci pour le retour !
La classe
TableUpdaterest réglée par défaut suracSpreadsheetTypeExcel12, mais sa propriétéExcelVersionest modifiable. Par exemple, de cette manière :Il y a un exemple plus détaillé dans le 4ème article de la série.
Je n’ai pas testé avec Excel 2003, mais l’importation devrait fonctionner également.