Access et VB

'Procédure chargemement charge les données dans les tables correspondantes
'Pas de paramètres
Public Sub chargement()

    'Déclaration des variables chaînes de caractères
    Dim fichier_import As String
    Dim fichier_table As String
    Dim msg_erreur As String
    Dim g As String
    Dim c As String
    Dim s As String
    Dim l As String
    
    'Déclaration d'un entier
    Dim choix As Integer
    
    'Déclaration des recordsets
    Dim rst As DAO.Recordset
    Dim rst_g As DAO.Recordset
    Dim rst_c As DAO.Recordset
    Dim rst_l As DAO.Recordset
    Dim rst_s As DAO.Recordset
    Dim rst_gest As DAO.Recordset
    Dim rst_cpt As DAO.Recordset
    Dim rst_lieu As DAO.Recordset
    Dim rst_serie As DAO.Recordset

    'En cas d'erreur on va à l'étiquette Gestion_Erreur
    On Error GoTo Gestion_Erreur
    
    'Initialisation des chaines de caractères
    g = "SELECT * FROM Tables WHERE Code_table='g'"
    s = "SELECT * FROM Tables WHERE Code_table='s'"
    c = "SELECT * FROM Tables WHERE Code_table='c'"
    l = "SELECT * FROM Tables WHERE Code_table='l'"
    
    
    'On demande à l'utilisateur si il veut vraiment charger les tables
    choix = MsgBox("Voulez vous charger les tables?", vbYesNo + vbQuestion, "Demande chargement")
    
    'Si non
    If choix = vbNo Then
        'Affichage d'un message pour lui dire que le chargemement a été annulé
        MsgBox "Chargement annulé", vbInformation, "Arrêt"
        'On sort de la procédure
        Exit Sub
    Else 'Si il confirme le chargemement
    
        'On active le sablier
        DoCmd.Hourglass True
        
        'On ouvre la fenêtre Etat
        DoCmd.OpenForm "Etat"
        
        'Affichage de l'état d'avancement
        Call Forms("Etat").Progress("IMPORTATION", "Consultation de la table PARAMETRES")
        'Boucle de temporisation pour la lecture du message
        For i = 1 To 5000000
        Next i
        
        'Si la table paramètre n'est pas renseigné
        'On prévient l'utilisateur et on va à l'étiquette Exit_chargemement
        If parametre("chemin_fichier") = "Non renseigné" Then
            msg_erreur = "Chargement abandonné. Répertoire de travail non renseigné dans la table des paramètres."
            MsgBox msg_erreur, vbOKOnly + vbCritical + vbDefaultButton1, "Importation"
            GoTo Exit_Chargement
        End If
        
        'On ferme la fenêtre état
        DoCmd.Close acForm, "Etat"
        
        'On appelle la procédure purge
        Call purge
        
        'On ouvre la fenêtre Etat
        DoCmd.OpenForm "Etat"
        
        'Affichage de l'état d'avancement
        Call Forms("Etat").Progress("CHARGEMENT", "Chargement des données dans la table IMMOBILISATION")
        'Boucle de temporisation pour la lecture du message
        For i = 1 To 5000000
        Next i
        
        'On importe le fichier immobilisation.txt selon les spécifications d'importations
        fichier_import = parametre("chemin_fichier") & "immobilisation.txt"
        DoCmd.TransferText acImportDelim, "Spécification d'importation", "Immobilisation", fichier_import, False
        
        'Affichage de l'état d'avancement
        Call Forms("Etat").Progress("CHARGEMENT", "Chargement des données dans les tables correspondantes")
        'Boucle de temporisation pour la lecture du message
        For i = 1 To 5000000
        Next i
        
        'On importe le fichier tables.txt selon les spécifications d'importation
        fichier_table = parametre("chemin_fichier") & "tables.txt"
        DoCmd.TransferText acImportDelim, "Tables Spécification d'importation", "Tables", fichier_table, False
        
        
        'Initialisation de tous les recordsets
        Set rst_gest = CurrentDb.OpenRecordset("Gestion")
        Set rst_cpt = CurrentDb.OpenRecordset("Compte")
        Set rst_lieu = CurrentDb.OpenRecordset("Lieu utilisation")
        Set rst_serie = CurrentDb.OpenRecordset("Série Articles")
        Set rst_c = CurrentDb.OpenRecordset(c, dbOpenDynaset)
        Set rst_g = CurrentDb.OpenRecordset(g, dbOpenDynaset)
        Set rst_l = CurrentDb.OpenRecordset(l, dbOpenDynaset)
        Set rst_s = CurrentDb.OpenRecordset(s, dbOpenDynaset)
      
        'On répartit les données de la table Tables dans la table gestion
        'Lorsque le code_table='g'
        Do Until rst_g.EOF
           rst_gest.AddNew
           rst_gest("Code_gestion_achat") = rst_g("Champ1")
           rst_gest("Code_gestion_utilisatrice") = rst_g("Champ2")
           rst_gest("Libellé") = rst_g("Champ3")
           rst_gest("Code_table") = rst_g("Code_table")
           rst_gest.Update
           rst_g.MoveNext
        Loop
        'Fermeture des recordset utilisés
        rst_g.Close
        rst_gest.Close
        
       'On répartit les données de la table Tables dans la table compte
       'Lorsque le code_table='c'
       Do Until rst_c.EOF
            rst_cpt.AddNew
            rst_cpt("N°Compte") = rst_c("Champ1")
            rst_cpt("Libellé") = rst_c("Champ2")
            rst_cpt("Code_table") = rst_c("Code_table")
            rst_cpt.Update
            rst_c.MoveNext
        Loop
        'Fermeture des recordsets utilisés
        rst_c.Close
        rst_cpt.Close
      
       'On répartit les données de la table Tables dans la table lieu_utilisation
       'Lorsque le code_table='l'
        Do Until rst_l.EOF
            rst_lieu.AddNew
            rst_lieu("Code_lieu_utilisation") = rst_l("Champ1")
            rst_lieu("Libellé") = rst_l("Champ2")
            rst_lieu("Code_table") = rst_l("Code_table")
            rst_lieu.Update
            rst_l.MoveNext
        Loop
        'Fermeture des recordsets utilisés
        rst_l.Close
        rst_lieu.Close
        
       'On répartit les données de la table Tables dans la table lsérie
       'Lorsque le code_table='s'
        Do Until rst_s.EOF
            rst_serie.AddNew
            rst_serie("Code_série_articles") = rst_s("Champ1")
            rst_serie("Libellé") = rst_s("Champ2")
            rst_serie("Code_table") = rst_s("Code_table")
            rst_serie.Update
            rst_s.MoveNext
        Loop
        'Fermeture des recordsets utilisés
        rst_s.Close
        rst_serie.Close
        
        'On ouvre la table immobilisation
        Set rst = CurrentDb.OpenRecordset("Immobilisation")
        
        If Not rst.EOF Then
            rst.MoveFirst
            Do Until rst.EOF
                rst.Edit
                'On modifie le Montant_achat et le Montant_reprise_enregistrement01 pour les avoir en €
                rst("Montant_achat") = rst("Montant_achat") / 100
                rst("Montant_reprise_enregistrement01") = rst("Montant_reprise_enregistrement01") / 100
                rst.Update
                rst.MoveNext
            Loop
        End If
        
        'On désactive le sablier
        DoCmd.Hourglass False
        'on ferme la fenêtre Etat
        DoCmd.Close acForm, "Etat"
        'On affiche un message pour prévenir que l'opération s'est déroulée corrrectement
        MsgBox "Chargement terminé", vbInformation, "Chargement réussi"
        
    End If
Exit Sub
    
'Etiquette de sortie du chargement
Exit_Chargement:
    'On désactive le sablier
    DoCmd.Hourglass False
    'On ferme la fenêtre Etat
    DoCmd.Close acForm, "Etat"
    'On affiche un message d'erreur
    MsgBox "Problème lors du chargement", vbCritical, "Erreur"
    'On sort de la procédure
    Exit Sub
        
'Etiquette de gestion des erreurs
Gestion_Erreur:
    'Selon le numéro d'erreur on affiche le message approprié et on va
    'à l'étiquette Exit_chargement
    Select Case Err
        Case 3011
            msg_erreur = "Importation abandonnée. Fichier " & fichier_import & " non trouvé."
            MsgBox msg_erreur, vbOKOnly + vbCritical + vbDefaultButton1, "Chargement"
            Resume Exit_Chargement
         Case 3044
            msg_erreur = "La disquette n'est pas insérée ou le chemin " & lfichier_import & " n'est pas valide."
            MsgBox msg_erreur, vbOKOnly + vbCritical + vbDefaultButton1, "Chargement"
            Resume Exit_Chargement
         Case Else
            MsgBox "Erreur n° " & Err & "  : " & Err.Description
            Resume Exit_Chargement
    End Select
    
End Sub