Option Compare Database '**** '* '* Main methods for OpenAccess add-in '* '**** Public Const opInterrupted = 10 Public Const opCancelled = 11 Public Const opCompleted = 12 '>> main function, called when addin is run Public Function main() DoCmd.OpenForm "OpenAccess" End Function Public Function make_sources(Optional ByVal optimizer As Boolean = True, _ Optional ByVal zip As Boolean = True) As Integer 'exports the source-code of the app On Error GoTo err Dim step As String make_sources = opInterrupted step = "Initialization" If optimizer Then Call activate_optimizer End If 'Save is needed to correctly list objects to export SaveProject If Not prompt_for_export_confirmation 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 VCS Export" logger "make_sources", "INFO", step Call ExportAllSource ' 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 = "Following objects do not exist anymore, do you want to delete treir source files?" & vbNewLine & _ "" & msg If OA_MsgBox(msg, vbYesNo, "Cleaning") = vbYes Then Call CleanDirs End If End If make_sources = opCompleted 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 Call update_oa_param("sources_date", CStr(old_sources_date)) 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 Dim backup_ok As Boolean Dim step, msg As String update_from_sources = opInterrupted 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 = "Prompt for confirmation" If Not prompt_for_import_confirmation Then GoTo cancelOp End If step = "Run VCS Import" logger "update_from_sources", "INFO", step Call ImportAllSource 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 update_from_sources = opCompleted 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", "CRITICAL", "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") '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(optimizer:=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