Option Compare Database
Option Explicit
Dim CurDtb  As Database     ' Pointeur sur la base de données

Private Sub Form_Load()
    

    UpdateDatabase "GRS", "GRS"
    UpdateDatabase "INS", "NEG"
    
    DoCmd.Close
    DoCmd.Quit
End Sub
    
Private Sub UpdateDatabase(CatCli As String, DtbTyp As String)
    Dim DtbNam As String
    Dim FlePth As String
    Dim CntFlg As Boolean
    Dim CurFrm As Form
    
    CntFlg = True
    Progression.Value = "Update Database " & DtbTyp
    Progression.Visible = True
    
    DoEvents
    '            ----------------------------------------------
    
    ' Création de liens sur les tables de la base de données RESS_COM_LOCAL
    DtbNam = "D:\Access_Appl\" & DtbTyp & "\Ress_Com_Local.mdb"
    If CntFlg Then CntFlg = Link("Lignes et familles", "LstFsf", DtbNam)
    If CntFlg Then CntFlg = Link("Articles", "Art", DtbNam)
    If CntFlg Then CntFlg = Link("Secteurs", "Sct", DtbNam)
    If CntFlg Then CntFlg = Link("Clients", "Cli", DtbNam)
    If CntFlg Then CntFlg = Link("Adresses", "Adr", DtbNam)
    If CntFlg Then CntFlg = Link("Interlocuteurs", "Int", DtbNam)
    If CntFlg Then CntFlg = Link("Conditions", "Condx", DtbNam)
    If CntFlg Then CntFlg = Link("Offres en cours", "Offres", DtbNam)
    If CntFlg Then CntFlg = Link("Remorques", "Rem", DtbNam)
    
    ' Création de liens sur les tables de la base de données RESS_HISTORIQUE
    DtbNam = "D:\Access_Appl\" & DtbTyp & "\Ress_Historique.mdb"
    If CntFlg Then CntFlg = Link("CA Client/Lig", "CACliLig", DtbNam)
    If CntFlg Then CntFlg = Link("CA Client/Lig/Fsf (A  )", "CACliLigFsf(A)", DtbNam)
    If CntFlg Then CntFlg = Link("CA Client/Lig/Fsf (A-1)", "CACliLigFsf(A-1)", DtbNam)
    If CntFlg Then CntFlg = Link("CA Client/Lig/Fsf (A-2)", "CACliLigFsf(A-2)", DtbNam)
    If CntFlg Then CntFlg = Link("CA Client/Lig/Fsf (A-3)", "CACliLigFsf(A-3)", DtbNam)
    If CntFlg Then CntFlg = Link("CA Client/Lig/Fsf (A-4)", "CACliLigFsf(A-4)", DtbNam)
    If CntFlg Then CntFlg = Link("CA Client/Mois", "CACliMois", DtbNam)
    If CntFlg Then CntFlg = Link("CA Client/Mois (A  )", "CACliMois(A)", DtbNam)
    If CntFlg Then CntFlg = Link("CA Client/Mois (A-1)", "CACliMois(A-1)", DtbNam)
    If CntFlg Then CntFlg = Link("CA Client/Mois (A-2)", "CACliMois(A-2)", DtbNam)
    If CntFlg Then CntFlg = Link("CA Client/Mois (A-3)", "CACliMois(A-3)", DtbNam)
    If CntFlg Then CntFlg = Link("CA Client/Mois (A-4)", "CACliMois(A-4)", DtbNam)
    If CntFlg Then CntFlg = Link("Mois", "Mois", DtbNam)
    If CntFlg Then CntFlg = Link("Mvt (A  )", "Mvt", DtbNam)
    If CntFlg Then CntFlg = Link("Mvt (A-1)", "Mvt-1", DtbNam)
    If CntFlg Then CntFlg = Link("Mvt (A-2)", "Mvt-2", DtbNam)
    If CntFlg Then CntFlg = Link("Mvt (A-3)", "Mvt-3", DtbNam)
    If CntFlg Then CntFlg = Link("Mvt (A-4)", "Mvt-4", DtbNam)
    If CntFlg Then CntFlg = Link("Vte (A  )", "Vte", DtbNam)
    If CntFlg Then CntFlg = Link("Vte (A-1)", "Vte-1", DtbNam)
    If CntFlg Then CntFlg = Link("Vte (A-2)", "Vte-2", DtbNam)
    If CntFlg Then CntFlg = Link("Vte (A-3)", "Vte-3", DtbNam)
    If CntFlg Then CntFlg = Link("Vte (A-4)", "Vte-4", DtbNam)
    
    '            ----------------------------------------------
    ' Rechargement des tables liées à RESS_COM_LOCAL
    FlePth = "I:\ACCESS_APPL\TEMP\" & CatCli & "\"
    If CntFlg Then CntFlg = ReloadTable("Lignes et familles", "LstFsf", FlePth & "TBC_FSF.TXT", "TBC_Fsf_" & CatCli)
    If CntFlg Then CntFlg = ReloadTable("Articles", "Art", FlePth & "TBC_ART.TXT", "TBC_Art_" & CatCli)
    If CntFlg Then CntFlg = ReloadTable("Secteurs", "Sct", FlePth & "TBC_SCT.TXT", "TBC_Sct_" & CatCli)
    If CntFlg Then CntFlg = ReloadTable("Clients", "Cli", FlePth & "TBC_CLI.TXT", "TBC_Cli_" & CatCli)
    If CntFlg Then CntFlg = ReloadTable("Adresses", "Adr", FlePth & "TBC_ADR.TXT", "TBC_Adr_" & CatCli)
    If CntFlg Then CntFlg = ReloadTable("Interlocuteurs", "Int", FlePth & "TBC_INT.TXT", "TBC_Int_" & CatCli)
    If CntFlg Then CntFlg = ReloadTable("Conditions", "Condx", FlePth & "TBC_CND.TXT", "TBC_Cnd_" & CatCli)
    If CntFlg Then CntFlg = ReloadTable("Offres en cours", "Offres", FlePth & "TBC_DEV.TXT", "TBC_Dev_" & CatCli)
    If CntFlg Then CntFlg = ReloadTable("Remorques", "Rem", FlePth & "TBC_REM.TXT", "TBC_Rem_" & CatCli)

    ' Rechargement des tables liées à RESS_HISTORIQUE
     If CntFlg Then CntFlg = AddToTable("Entêtes de ventes(N)", "vte", FlePth & "TBC_VTE.TXT", "TBC_Vte_" & CatCli)
     If CntFlg Then CntFlg = AddToTable("Lignes  de ventes(N)", "mvt", FlePth & "TBC_MVT.TXT", "TBC_Mvt_" & CatCli)
    
    
    '            ----------------------------------------------
    ' CalcTableul cumuls / familles et par mois
    If CntFlg = True Then CalcTable "CACliMois(A)", "Clc_CACliMois(A)"
    If CntFlg = True Then CalcTable "CACliMois", "Clc_CACliMois"
    If CntFlg = True Then CalcTable "CACliLigFsf(A)", "Clc_CACliLigFsf(A)"
    If CntFlg = True Then CalcTable "CACliLig", "Clc_CACliLig"

    '            ----------------------------------------------
    ' Destruction des liens sur les tables de la base de données RESS_COM_LOCAL
    DtbNam = "D:\Access_Appl\" & DtbTyp & "\Ress_Com_Local.mdb"
    If CntFlg Then CntFlg = UnLink("Lignes et familles", "LstFsf")
    If CntFlg Then CntFlg = UnLink("Articles", "Art")
    If CntFlg Then CntFlg = UnLink("Secteurs", "Sct")
    If CntFlg Then CntFlg = UnLink("Clients", "Cli")
    If CntFlg Then CntFlg = UnLink("Adresses", "Adr")
    If CntFlg Then CntFlg = UnLink("Interlocuteurs", "Int")
    If CntFlg Then CntFlg = UnLink("Conditions", "Condx")
    If CntFlg Then CntFlg = UnLink("Offres en cours", "Offres")
    If CntFlg Then CntFlg = UnLink("Remorques", "Rem")
    
    ' Destruction des liens sur les tables de la base de données RESS_HISTORIQUE
    DtbNam = "D:\Access_Appl\" & DtbTyp & "\Ress_Historique.mdb"
    If CntFlg Then CntFlg = UnLink("CA Client/Lig", "CACliLig")
    If CntFlg Then CntFlg = UnLink("CA Client/Lig/Fsf (A  )", "CACliLigFsf(A)")
    If CntFlg Then CntFlg = UnLink("CA Client/Lig/Fsf (A-1)", "CACliLigFsf(A-1)")
    If CntFlg Then CntFlg = UnLink("CA Client/Lig/Fsf (A-2)", "CACliLigFsf(A-2)")
    If CntFlg Then CntFlg = UnLink("CA Client/Lig/Fsf (A-3)", "CACliLigFsf(A-3)")
    If CntFlg Then CntFlg = UnLink("CA Client/Lig/Fsf (A-4)", "CACliLigFsf(A-4)")
    If CntFlg Then CntFlg = UnLink("CA Client/Mois", "CACliMois")
    If CntFlg Then CntFlg = UnLink("CA Client/Mois (A  )", "CACliMois(A)")
    If CntFlg Then CntFlg = UnLink("CA Client/Mois (A-1)", "CACliMois(A-1)")
    If CntFlg Then CntFlg = UnLink("CA Client/Mois (A-2)", "CACliMois(A-2)")
    If CntFlg Then CntFlg = UnLink("CA Client/Mois (A-3)", "CACliMois(A-3)")
    If CntFlg Then CntFlg = UnLink("CA Client/Mois (A-4)", "CACliMois(A-4)")
    If CntFlg Then CntFlg = UnLink("Mois", "Mois")
    If CntFlg Then CntFlg = UnLink("Mvt (A  )", "Mvt")
    If CntFlg Then CntFlg = UnLink("Mvt (A-1)", "Mvt-1")
    If CntFlg Then CntFlg = UnLink("Mvt (A-2)", "Mvt-2")
    If CntFlg Then CntFlg = UnLink("Mvt (A-3)", "Mvt-3")
    If CntFlg Then CntFlg = UnLink("Mvt (A-4)", "Mvt-4")
    If CntFlg Then CntFlg = UnLink("Vte (A  )", "Vte")
    If CntFlg Then CntFlg = UnLink("Vte (A-1)", "Vte-1")
    If CntFlg Then CntFlg = UnLink("Vte (A-2)", "Vte-2")
    If CntFlg Then CntFlg = UnLink("Vte (A-3)", "Vte-3")
    If CntFlg Then CntFlg = UnLink("Vte (A-4)", "Vte-4")
    If CntFlg = False Then GoTo ErrTrt
    Exit Sub
    
ErrTrt:
    MsgBox ("Une erreur est survenue, le traitement a été arrêté")
End Sub


Private Function Link(LibOpr As String, TblNam As String, DtaPth As String)
    Link = False
    
    Progression.Value = "Link " & DtaPth & " : " & LibOpr & "." & Strings.Chr(13) & Strings.Chr(10) & Progression.Value
    DoEvents
    
    On Error Resume Next
    DoCmd.DeleteObject acTable, TblNam
    
    On Error GoTo ErrTrt
    DoCmd.TransferDatabase acLink, "Microsoft Access", DtaPth, acTable, TblNam, TblNam
        
    Link = True
    Exit Function
   
ErrTrt:
End Function

Private Function UnLink(LibOpr As String, TblNam As String)
    UnLink = False
    
    Progression.Value = "UnLink " & LibOpr & "." & Strings.Chr(13) & Strings.Chr(10) & Progression.Value
    DoEvents
    
    On Error Resume Next
    DoCmd.DeleteObject acTable, TblNam
    
    UnLink = True
    Exit Function
   
ErrTrt:
End Function
Private Function ReloadTable(LibOpr As String, TblNam As String, DtaPth As String, FmtNam)
    On Error GoTo ErrTrt
    ReloadTable = False
    
    Progression.Value = "Remplacement " & TblNam & "." & Strings.Chr(13) & Strings.Chr(10) & Progression.Value
    DoEvents
    
    If EraseTable(TblNam) Then
        DoCmd.TransferText acImportDelim, FmtNam, TblNam, DtaPth, True
        ReloadTable = True
    End If
    Exit Function
   
ErrTrt:
End Function

Private Function AddToTable(LibOpr As String, TblNam As String, DtaPth As String, FmtNam)
    On Error GoTo ErrTrt
    AddToTable = False
    
    Progression.Value = "Ajout " & TblNam & "." & Strings.Chr(13) & Strings.Chr(10) & Progression.Value
    DoEvents
    
    DoCmd.TransferText acImportDelim, FmtNam, TblNam, DtaPth, True
    
    AddToTable = True
    Exit Function
   
ErrTrt:
End Function

Private Function EraseTable(TblNam As String) As Boolean
    Dim QryStat  As QueryDef        ' Buffer pour requête sur base
    
    On Error GoTo ErrTrt
    EraseTable = False
    
    ' Récupération pointeur sur la base courante
    Set CurDtb = CurrentDb()
    
    ' Requête sur la base
    Set QryStat = CurDtb.CreateQueryDef("", "delete * from [" & TblNam & "];")
    QryStat.Execute (dbDenyWrite)
    QryStat.Close
    
    EraseTable = True
    Exit Function
   
ErrTrt:
End Function


Private Sub CalcTable(TblNam As String, QryNam As String)
    Progression.Value = "Calcul " & TblNam & Strings.Chr(13) & Strings.Chr(10) & Progression.Value
    DoEvents
    If EraseTable(TblNam) Then
        DoCmd.OpenQuery QryNam
    End If

End Sub