Zo af en toe wil de gebruiker aanpassingen in de database. Deze worden altijd in een testomgeving aangebracht en getest. Nadat wijzigingen in de testomgeving door de gebruiker zijn goedgekeurd, wordt er een nieuwe versie gereleased. Hieronder beschrijf ik hoe in VBA de broncode database wordt opgeslagen als ACCDE bestand.
Een volgend keer dat de gebruiker de applicatie start wordt door eenopstart routine eerst gecheckt of de gebruiker wel de laatste versie lokaal heeft staan. Zoniet dan wordt de laatste versie van de server naar een lokale PC gekopieerd. Dit proces beschrijf ik in een andere pagina versiebeheer stap 2 van 2





  
    Public Sub ap_Maak_ACCDE_versie(versie As String)
'-- 2014.10.17 22u00

    Dim tmpDB_Full_Name As String
    Dim tmpDB_Name As String
    Dim tmpDB_Backup_Full_Name As String
    Dim tmpCopy_File As Variant
    Dim tmpDirectory As String
    
    Dim NaamACCDE As String, NaamACCDE_versienr As String
    Dim prodACCDEopserver As String, testACCDEopserver As String, ACCDEopserver As String
    Dim ACCDB_broncode As String
    Dim ACCDB_broncode_versienr As String
     Dim PadDatumTijdKopienOpServer As String
    'Call SetStartupOptions("AllowBypassKey",  dbBoolean, False)               ---This runs a procedure to deactivate the Shift & F11 key

On Error GoTo foutafhandeling


    '-- HUIDIGE BRONCODE WAAR NU INGEWERKT WORDT
    tmpDB_Full_Name = CurrentProject.FullName
    
    '-- PAD HUIDIGE BRONCODE
    tmpDirectory = CurrentProject.Path
    
    '-- NAAM TIJDELIJKE DATABASE
    tmpDB_Name = CurrentProject.Name
 
 
 Screen.MousePointer = 11
 
    '-- maak naam voor een datumtijdkopie van de broncode
    versie = Replace(versie, ".", "_")
    ACCDB_broncode_versienr = tmpDirectory & "\" & Left(tmpDB_Name, Len(tmpDB_Name) - 6) & "_versie_" & versie & ".accdb"
    
    tmpDB_Backup_Full_Name = ACCDB_broncode_versienr

    'this removes a file created on the same day
    If Dir(tmpDB_Backup_Full_Name) <> "" Then
        Kill tmpDB_Backup_Full_Name
    End If


    'this creates a backup into destination tmpDirectory
    If Dir(tmpDB_Backup_Full_Name) = "" Then
        Set tmpCopy_File = CreateObject("Scripting.FileSystemObject")
        tmpCopy_File.CopyFile tmpDB_Full_Name, tmpDB_Backup_Full_Name, True
    End If

    'de broncode ACCDB is nu gekopieerd naa submapje oude_ACCDBs met versienr in de filenaam

    Dim app As New Access.Application
        
    'app.AutomationSecurity = 1 'msoAutomationSecurityLow
    app.AutomationSecurity = 1 ' msoAutomationSecurityLow  'let op dit is officeversie afhandelijk
    
    NaamACCDE = tmpDirectory & "\" & Left(tmpDB_Name, Len(tmpDB_Name) - 6) & ".accde"""
    If GetFileAttributes(NaamACCDE) <> -1 Then
        Kill NaamACCDE
    End If
    If GetFileAttributes(tmpDB_Backup_Full_Name) = -1 Then
        MsgBox tmpDB_Backup_Full_Name, vbCritical, "File not found"
    End If
    '--  !!   MAAK EEN ACCDE !!
    app.SysCmd 603, tmpDB_Backup_Full_Name, NaamACCDE
    
    
    NaamACCDE_versienr = tmpDirectory & "\oude_ACCDEs\" & Left(tmpDB_Name, Len(tmpDB_Name) - 6) & "_versie_" & versie & ".accde"
    If GetFileAttributes(NaamACCDE_versienr) <> -1 Then
        Kill NaamACCDE_versienr
    End If
    
    'maak ook een ACCDE met versie nr in de naam, waarom deed ik dit eigenlijk ??
    app.SysCmd 603, tmpDB_Backup_Full_Name, NaamACCDE_versienr
    
    '-- PRODUCTIE MAP OP SERVER VOOR DE GEBRUIKERS
    
    If bTest Then
        ACCDEopserver = "S:\Database\SSY_TEST.accde"
    Else
        ACCDEopserver = "S:\Database\SSY_PROD.accde"
    End If
    
    If GetFileAttributes(ACCDEopserver) <> -1 Then
        Kill ACCDEopserver
    End If
    
    Debug.Print NaamACCDE_versienr
    Debug.Print prodACCDEopserver
    
    
    
    CopyFile NaamACCDE_versienr, ACCDEopserver, -1
    
    
    '-- ACCDB_versie_XXX verplaatsen naar mapje ouude_ACCDBS
    tmpDB_Backup_Full_Name = tmpDirectory & "\" & Left(tmpDB_Name, Len(tmpDB_Name) - 6) & "_versie_" & versie & ".accdb"
    ACCDB_broncode_versienr = tmpDirectory & "\oude_ACCDBs\" & Left(tmpDB_Name, Len(tmpDB_Name) - 6) & "_versie_" & versie & ".accdb"
    
    
    If GetFileAttributes(ACCDB_broncode_versienr) <> -1 Then
        Kill ACCDB_broncode_versienr
    End If
    If GetFileAttributes(tmpDB_Backup_Full_Name) <> -1 Then
        CopyFile tmpDB_Backup_Full_Name, ACCDB_broncode_versienr, -1
        Kill tmpDB_Backup_Full_Name
    End If
    
    
    
    
      MsgBox "Klaar met releasen van versie " & NaamACCDE_versienr
      Exit Sub
    
    '-- BRONCODE ARCHIEF OUDE VERSIES
    PadDatumTijdKopienOpServer = "S:\database\broncode_sqlserver\oude_ACCDBs\"
    ACCDB_broncode_versienr = PadDatumTijdKopienOpServer & Left(tmpDB_Name, Len(tmpDB_Name) - 6) & "_versie_" & versie & ".accdb"
    
    Debug.Print ACCDB_broncode_versienr
    
    
    If GetFileAttributes(ACCDB_broncode_versienr) <> -1 Then
        Kill ACCDB_broncode_versienr
    End If
    Debug.Print tmpDB_Backup_Full_Name
    CopyFile tmpDB_Backup_Full_Name, ACCDB_broncode_versienr, -1
    
    
    '-- BRONCODE !!!
    ACCDB_broncode = "S:\database\broncode_sqlserver\" & CurrentProject.Name
    If GetFileAttributes(ACCDB_broncode) <> -1 Then
       '  Kill ACCDB_broncode
    End If
  '  MsgBox NaamACCDE_versienr
    
    If GetFileAttributes(NaamACCDE_versienr) = -1 Then
        MsgBox "Kan " & NaamACCDE_versienr & " niet vinden!!", vbCritical, "onwijs"
    Else
        FileCopy NaamACCDE_versienr, ACCDB_broncode
    End If
    
    
    
    
    
   ' Call SetStartupOptions("AllowBypassKey", dbBoolean, True)
    ''---This runs a procedure to activate the Shift & F11
    
    MsgBox "Klaar met releasen van versie " & NaamACCDE_versienr
Screen.MousePointer = 0

exit_here:
Screen.MousePointer = 0

    Exit Sub

foutafhandeling:
    MsgBox Err.description
    GoTo exit_here
End Sub
Met als resultaat de oude broncode veilig gesteld


En de nieuw te releasen ACCDE klaar voor de gebruiker