Option Compare Database Option Explicit '**** '* '* Main methods for OpenAccess add-in '* '**** Public Const opInterrupted = 10 Public Const opCancelled = 11 Public Const opCompleted = 12 Public Const opCompletedWithErrors = 13 Dim debug_mode As Boolean Public Sub activate_debug_mode() debug_mode = True End Sub '>> main function, called when addin is run Public Function main() DoCmd.OpenForm "OpenAccess" End Function Public Function make_sources(Optional ByVal newer_only As Boolean = False, _ Optional ByVal zip As Boolean = True) As Integer 'exports the source-code of the app If Not debug_mode Then On Error GoTo err Dim step As String Dim msg As String make_sources = opInterrupted step = "Initialization" 'Save is needed to correctly list objects to export SaveProject step = "Prompt for confirmation" msg = "**** OPENACCESS EXPORT ****" & vbNewLine & _ "You're going to export:" & vbNewLine & vbNewLine & _ msg_list_to_export(newer_only) & _ "" If Not OA_MsgBox(msg, vbOKCancel + vbExclamation, "Confirm") = vbOK Then GoTo cancelOp End If If zip Then ' zip the app file step = "Zip the app file" logger "make_sources", "INFO", step Call zip_app_file End If ' run the export step = "Run Open Access Export" logger "make_sources", "INFO", step ExportAll newer_only ' new sources date step = "Updates sources date" logger "make_sources", "INFO", step Call update_sources_date ' cleans the obsolete files (see CleanDirs in optimizer) msg = CleanDirs(True) If Len(msg) > 0 Then msg = "# CLEANING # " & vbNewLine & "Following objects do not exist anymore, do you want to DELETE their source FILES?" & vbNewLine & _ "" & msg If OA_MsgBox(msg, vbYesNo, "Cleaning Source Files") = vbYes Then Call CleanDirs End If End If If errors_occured() Then make_sources = opCompletedWithErrors Else make_sources = opCompleted End If Exit Function err: OA_MsgBox "Unknown error - " & err.Description & " (#" & err.Number & ")" & vbNewLine & "See the log file for more information", vbCritical, "CRITICAL ERROR" If err.Number <> "60000" Then logger "make_sources", "ERROR", "Unknown error at: " & step & " - " & err.Description & "(#" & err.Number & ")" End If Exit Function cancelOp: make_sources = opCancelled Exit Function End Function Public Function update_from_sources(Optional ByVal backup As Boolean) As Integer 'updates the application from the sources If Not debug_mode Then On Error GoTo err Dim backup_ok As Boolean Dim step As String Dim msg As String update_from_sources = opInterrupted step = "Prompt for confirmation" msg = "**** OPENACCESS IMPORT ****" & vbNewLine & _ "You're going to update " & UCase(CurrentProject.name) & " with the sources files" & vbNewLine & vbNewLine & _ "WARNING: Any non exported work would be lost!" If Not OA_MsgBox(msg, vbOKCancel + vbExclamation, "Confirm") = vbOK Then GoTo cancelOp End If If backup Then step = "Creates a backup of the app file" logger "update_from_sources", "INFO", step backup_ok = make_backup() If Not backup_ok Then logger "update_from_sources", "ERROR", "Error: unable to backup the app file, do it manually, then click OK" OA_MsgBox "Error: unable to backup the app file, do it manually, then click OK", vbExclamation, "Backup" End If End If step = "Run Open Access Import" logger "update_from_sources", "INFO", step Call ImportAll step = "Cleaning obsolete objects in app" msg = CleanApp(True) If Len(msg) > 0 Then msg = "Following objects do not exist in the sources, do you want to delete them?" & vbNewLine & _ "" & msg If OA_MsgBox(msg, vbYesNo, "Cleaning") = vbYes Then Call CleanApp End If End If ' new sources date to keep the optimizer working step = "Updates sources date" logger "update_from_sources", "INFO", step Call update_sources_date If errors_occured() Then update_from_sources = opCompletedWithErrors Else update_from_sources = opCompleted End If Exit Function err: OA_MsgBox "Unknown error - " & err.Description & " (#" & err.Number & ")" & vbNewLine & "See the log file for more information", vbCritical, "CRITICAL ERROR" If err.Number <> "60000" Then logger "update_from_sources", "ERROR", "Unknown error at: " & step & " - " & err.Description & "(#" & err.Number & ")" End If Exit Function cancelOp: update_from_sources = opCancelled Exit Function End Function Public Function zip_app_file() As Boolean On Error GoTo UnknownErr Dim command, shortname As String zip_app_file = False shortname = Split(CurrentProject.name, ".")(0) 'run the shell comand ' Call cmd("cd " & CurrentProject.path & " & " & _ ' "zip tmp_" & shortname & ".zip " & CurrentProject.name & _ ' " & exit") zipfile "tmp_" & shortname & ".zip", CurrentProject.path 'remove the old zip file If dir(CurrentProject.path & "\" & shortname & ".zip") <> "" Then Kill CurrentProject.path & "\" & shortname & ".zip" End If 'rename the temporary zip Call cmd("cd " & CurrentProject.path & " & " & _ "ren tmp_" & shortname & ".zip" & " " & shortname & ".zip" & _ " & exit") logger "zip_app_file", "INFO", CurrentProject.path & "\" & CurrentProject.name & " zipped to " & CurrentProject.path & "\" & shortname & ".zip" zip_app_file = True end_: Exit Function UnknownErr: logger "zip_app_file", "ERROR", "Unable to zip " & CurrentProject.path & "\" & CurrentProject.name & " - " & err.Description OA_MsgBox "Unknown error: unable to ZIP the app file, do it manually" GoTo end_ End Function Public Function make_backup() As Boolean On Error GoTo err make_backup = False If dir(CurrentProject.path & "\" & CurrentProject.name & ".old") <> "" Then Kill CurrentProject.path & "\" & CurrentProject.name & ".old" End If Call cmd("copy " & Chr(34) & CurrentProject.path & "\" & CurrentProject.name & Chr(34) & _ " " & Chr(34) & CurrentProject.path & "\" & CurrentProject.name & ".old" & Chr(34)) logger "make_backup", "INFO", CurrentProject.path & "\" & CurrentProject.name & " copied to " & CurrentProject.path & "\" & CurrentProject.name & ".old" make_backup = True Exit Function err: logger "make_backup", "ERROR", "Error during the backup of " & CurrentProject.name & ": " & err.Description OA_MsgBox "Error during the backup of " & CurrentProject.name & ": " & err.Description & vbNewLine & "Do it manually" End Function Public Function silent_export() 'used for tests OA_Msg.activate_SilentMode OA_Log.set_debug_mode Dim result As Variant result = make_sources(newer_only:=False, zip:=True) logger "silent_export", "INFO", "make_sources returned " & result End Function Public Function silent_import() 'used for tests OA_Msg.activate_SilentMode OA_Log.set_debug_mode Dim result As Variant result = update_from_sources(backup:=True) logger "silent_export", "INFO", "update_from_sources returned " & result End Function