Browse Source

Refactoring, création des modules OA_Export, OA_Import, OA_Document, OA_Path. Ajout du statut 13 (ok avec erreurs), de la progression de l'import, correction du fonctionnement des tests

olivier.massot 9 years ago
parent
commit
0da6bc5f68
45 changed files with 1269 additions and 1129 deletions
  1. BIN
      OpenAccess.zip
  2. 6 4
      source/forms/OpenAccess.bas
  3. 86 0
      source/modules/OA_Documents.bas
  4. 301 0
      source/modules/OA_Export.bas
  5. 379 0
      source/modules/OA_Import.bas
  6. 8 2
      source/modules/OA_Log.bas
  7. 23 11
      source/modules/OA_Main.bas
  8. 7 2
      source/modules/OA_Msg.bas
  9. 7 6
      source/modules/OA_Optimizer.bas
  10. 144 0
      source/modules/OA_Path.bas
  11. 1 0
      source/modules/OA_Properties.bas
  12. 2 0
      source/modules/OA_Shell.bas
  13. 5 2
      source/modules/OA_Utils.bas
  14. 3 3
      source/modules/VCS_DataMacro.bas
  15. 2 134
      source/modules/VCS_Dir.bas
  16. 2 3
      source/modules/VCS_File.bas
  17. 166 243
      source/modules/VCS_IE_Functions.bas
  18. 0 687
      source/modules/VCS_ImportExport.bas
  19. 36 14
      source/modules/VCS_Reference.bas
  20. 7 10
      source/modules/VCS_Table.bas
  21. 1 1
      source/tables/USysOpenAccess.txt
  22. 0 0
      source/tbldefs/USysOpenAccess.sql
  23. 6 0
      source/tbldefs/USysRegInfo.sql
  24. BIN
      tests/__pycache__/utilities.cpython-34.pyc
  25. BIN
      tests/initial/empty_project.zip
  26. BIN
      tests/initial/project0.zip
  27. 1 1
      tests/reference/source/database.properties
  28. 0 1
      tests/reference/source/references.csv
  29. 1 1
      tests/reference/source/reports/ReportTest.pv
  30. 0 0
      tests/reference/source/scripts/MacroTest.bas
  31. 17 0
      tests/reference/source/scripts/test_export.bas
  32. 17 0
      tests/reference/source/scripts/test_import.bas
  33. 1 1
      tests/reference/source/tables/TableTestBaseFields.txt
  34. 0 0
      tests/reference/source/tbldefs/TableTestAdvancedFields.sql
  35. 0 0
      tests/reference/source/tbldefs/TableTestBaseFields.sql
  36. 0 0
      tests/reference/source/tbldefs/TableTestRelation1.sql
  37. 0 0
      tests/reference/source/tbldefs/TableTestRelation2.sql
  38. 0 0
      tests/reference/source/tbldefs/TableTestRelation3.sql
  39. 0 0
      tests/reference/source/tbldefs/TableTestRelation4.sql
  40. 0 0
      tests/reference/source/tbldefs/TableTestSpecialChars_éèà@~êëç_[92]_[47]_[58]_[42]_[63]_[60]_[62]_[124].sql
  41. 0 0
      tests/reference/source/tbldefs/TableWithData.sql
  42. 0 0
      tests/reference/source/tbldefs/TableWithProperties.sql
  43. 4 0
      tests/reference/source/tbldefs/USysOpenAccess.sql
  44. 0 0
      tests/reference/source/tbldefs/linked_table.LNKD
  45. 36 3
      tests/test.py

BIN
OpenAccess.zip


+ 6 - 4
source/forms/OpenAccess.bas

@@ -22,9 +22,9 @@ Begin Form
     DatasheetFontHeight =11
     DatasheetFontHeight =11
     ItemSuffix =43
     ItemSuffix =43
     Left =-22140
     Left =-22140
-    Top =2415
+    Top =2430
     Right =-255
     Right =-255
-    Bottom =15150
+    Bottom =14565
     DatasheetGridlinesColor =14806254
     DatasheetGridlinesColor =14806254
     RecSrcDt = Begin
     RecSrcDt = Begin
         0xeb366d1c54d7e440
         0xeb366d1c54d7e440
@@ -1022,7 +1022,7 @@ Private Sub cmd_export_Click()
     RUNNING_OP = True
     RUNNING_OP = True
     
     
     ' update log path
     ' update log path
-    logger "cmd_export_Click", "INFO", "Run Export"
+    logger "cmd_export_Click", "INFO", "Start"
     Me.lbl_log_path.Caption = OA_Log.log_file
     Me.lbl_log_path.Caption = OA_Log.log_file
     
     
     ' update state
     ' update state
@@ -1053,7 +1053,7 @@ End If
 RUNNING_OP = True
 RUNNING_OP = True
 
 
 ' update log path
 ' update log path
-logger "cmd_import_Click", "INFO", "Run Export"
+logger "cmd_import_Click", "INFO", "Start"
 Me.lbl_log_path.Caption = OA_Log.log_file
 Me.lbl_log_path.Caption = OA_Log.log_file
 
 
 ' update state
 ' update state
@@ -1103,6 +1103,8 @@ Private Sub display_status(result As Variant)
     Select Case CInt(result)
     Select Case CInt(result)
         Case opCompleted
         Case opCompleted
             msg = msg & "> Done"
             msg = msg & "> Done"
+        Case opCompletedWithErrors
+            msg = msg & "> Done (Error(s) occured)"
         Case opInterrupted
         Case opInterrupted
             msg = msg & "> Interrupted"
             msg = msg & "> Interrupted"
         Case opCancelled
         Case opCancelled

+ 86 - 0
source/modules/OA_Documents.bas

@@ -0,0 +1,86 @@
+Option Compare Database
+Option Private Module
+Option Explicit
+
+'Dim UTF8CONVERSION As Boolean
+'Public Sub activate_Utf8Conversion()
+'    UTF8CONVERSION = True
+'End Sub
+
+Const UTF8CONVERSION = True
+
+Public Function get_container_name(ByVal acType As Integer)
+'return the name of an access object container from its acType
+
+    Select Case acType
+        Case acTable
+            get_container_name = "tables"
+        Case acForm
+            get_container_name = "forms"
+        Case acReport
+            get_container_name = "reports"
+        Case acMacro
+            get_container_name = "scripts"
+        Case acModule
+            get_container_name = "modules"
+    End Select
+
+End Function
+
+' Export a database object with optional UCS2-to-UTF-8 conversion.
+Public Sub ExportDocument(ByVal acType As Integer, ByVal obj_name As String, ByVal file_path As String)
+' encoding can be either 'UCS2' (default), either 'utf-8'
+    
+    logger "ExportDocument", "DEBUG", "Try to export " & obj_name & "(type " & acType & ")  from: " & file_path
+    
+    mktree parent_dir(file_path)
+    del_if_exist file_path
+    
+    Application.SaveAsText acType, obj_name, file_path
+
+    If acType <> acModule Then
+        If UTF8CONVERSION Then
+            logger "ExportDocument", "DEBUG", "Encode file in UTF-8"
+            Dim tempFileName As String
+            tempFileName = TempFile()
+            ConvertUcs2Utf8 file_path, tempFileName
+            Kill file_path
+            Name tempFileName As file_path
+        End If
+        
+        SanitizeFile file_path
+    End If
+    
+    logger "ExportDocument", "DEBUG", obj_name & " (type " & acType & ") exported to " & file_path
+
+End Sub
+
+' Import a database object with optional UTF-8-to-UCS2 conversion.
+Public Sub ImportDocument(ByVal acType As Integer, ByVal obj_name As String, ByVal file_path As String)
+    On Error GoTo err
+    Dim tempFileName As String
+    
+    logger "ImportDocument", "DEBUG", "Try to import " & obj_name & "(type " & acType & ")  from: " & file_path
+    
+    If acType <> acModule Then
+        If UTF8CONVERSION Then
+            logger "ImportDocument", "DEBUG", "Encode in UCS2 before import"
+            tempFileName = TempFile()
+            ConvertUtf8Ucs2 file_path, tempFileName
+            file_path = tempFileName
+        End If
+    End If
+    
+    Application.LoadFromText acType, obj_name, file_path
+    
+    logger "ImportDocument", "DEBUG", "> imported"
+
+end_:
+    If Len(tempFileName) > 0 Then
+        del_if_exist tempFileName
+    End If
+
+    Exit Sub
+err:
+    logger "ImportDocument", "CRITICAL", "Unable to import " & obj_name & "[" & err.Description & "]"
+End Sub

+ 301 - 0
source/modules/OA_Export.bas

@@ -0,0 +1,301 @@
+Option Compare Database
+Option Explicit
+
+Public Sub ExportAll(Optional ByVal newer_only As Boolean = False)
+    Dim db As DAO.Database
+
+    logger "ExportAllSource", "INFO", "Begin 'Export all sources'"
+    logger "ExportAllSource", "DEBUG", "> Newer only: " & newer_only
+    
+    ' try to save current project
+    Call SaveProject
+    
+    Set db = CurrentDb
+
+    ' close any opened form or report, except OpenAccess's form
+    Call CloseFormsReports
+
+    ' export database properties
+    Call ExportProperties(CurrentDb, joinpaths(source_dir, "database.properties"))
+
+    Call ExportAllQueries(newer_only)
+    
+    Call ExportAllDocs(acForm, newer_only)
+    
+    Call ExportAllDocs(acReport, newer_only)
+    
+    Call ExportAllDocs(acMacro, newer_only)
+
+    Call ExportAllDocs(acModule, newer_only)
+    
+    Call ExportAllTblDefs(newer_only)
+    
+    Call ExportAllTableDatas
+    
+    Call ExportReferences
+    
+    Call ExportAllRelations
+
+    logger "ExportAll", "INFO", "Export done"
+
+End Sub
+
+Public Sub ExportAllQueries(Optional ByVal newer_only As Boolean = False)
+    Dim dirpath As String
+    Dim count, total As Integer
+    Dim file_path As String
+    
+    Dim db As DAO.Database
+    Set db = CurrentDb()
+    Dim qry As Object
+    
+    dirpath = joinpaths(source_dir(), "queries\")
+    mktree dirpath
+    
+    logger "ExportAllQueries", "INFO", "Export queries"
+    logger "ExportAllQueries", "DEBUG", "> export to: " & dirpath
+    logger "ExportAllQueries", "DEBUG", "> Newer only: " & newer_only
+
+    count = 0
+    If newer_only Then
+        total = UBound(Split(list_to_export(acQuery), ";")) + 1
+    Else
+        total = db.QueryDefs.count
+    End If
+
+    For Each qry In db.QueryDefs
+    
+        If Left$(qry.name, 1) = "~" Then
+            logger "ExportAllQueries", "DEBUG", "Query " & qry.name & " ignored"
+            GoTo next_qry
+        End If
+    
+        If newer_only Then
+            If Not needs_export(acQuery, qry.name) > 0 Then
+                logger "ExportAllQueries", "DEBUG", "Query " & qry.name & " skipped"
+                GoTo next_qry
+            End If
+        End If
+        
+        'DoEvents 'utility?
+        file_path = joinpaths(dirpath, to_filename(qry.name) & ".bas")
+        
+        ExportDocument acQuery, qry.name, file_path
+        count = count + 1
+        
+        Call SysCmd(acSysCmdSetStatus, "Export query: " & count & " on " & total)
+        
+next_qry:
+    Next
+    
+    Call SysCmd(acSysCmdClearStatus)
+    logger "ExportAllQueries", "INFO", "> " & count & " queries exported"
+    
+End Sub
+
+Public Sub ExportAllDocs(ByVal acType As Integer, Optional ByVal newer_only As Boolean = False)
+'export all the documents of the acType
+    Dim doc_label As String
+    Dim dirpath As String
+    Dim count, total As Integer
+    Dim file_path As String
+    
+    Dim db As DAO.Database
+    Set db = CurrentDb()
+    Dim doc As Object
+    
+    'get the document's container's name from it's type
+    doc_label = get_container_name(acType)
+
+    If Len(doc_label) = 0 Then
+        logger "ExportAllDoc", "CRITICAL", "acType " & acType & " is not recognized!"
+        Exit Sub
+    End If
+
+    dirpath = joinpaths(source_dir(), doc_label & "\")
+    mktree dirpath
+    
+    logger "ExportAllDocs", "INFO", "# Export " & doc_label
+    logger "ExportAllDocs", "DEBUG", "> export to: " & dirpath
+    logger "ExportAllDocs", "DEBUG", "> newer only: " & newer_only
+
+    count = 0
+    If newer_only Then
+        total = UBound(Split(list_to_export(acType), ";")) + 1
+    Else
+        total = db.Containers(doc_label).Documents.count
+    End If
+
+    For Each doc In db.Containers(doc_label).Documents
+    
+        If Left$(doc.name, 1) = "~" Then
+            logger "ExportAllDocs", "DEBUG", doc_label & ": " & doc.name & " ignored"
+            GoTo next_doc
+        End If
+
+        If newer_only Then
+            If Not needs_export(acType, doc.name) > 0 Then
+                logger "ExportAllDocs", "DEBUG", doc_label & ": '" & doc.name & " skipped"
+                GoTo next_doc
+            End If
+        End If
+        
+        file_path = joinpaths(dirpath, to_filename(doc.name) & ".bas")
+        
+        ExportDocument acType, doc.name, file_path
+        
+        If doc_label = "reports" Then
+            file_path = joinpaths(dirpath, to_filename(doc.name) & ".pv")
+            ExportPrintVars doc.name, file_path
+        End If
+        
+        Call SysCmd(acSysCmdSetStatus, "Exporting " & doc_label & ": " & count & " on " & total)
+
+        count = count + 1
+                    
+next_doc:
+    Next
+
+    Call SysCmd(acSysCmdClearStatus)
+    logger "ExportAllDocs", "INFO", "> " & count & " " & doc_label & " exported"
+
+End Sub
+
+Public Sub ExportAllTblDefs(Optional ByVal newer_only As Boolean = False)
+'export table definitions
+    Dim dirpath, file_path As String
+    Dim count, total As Integer
+    Dim td As DAO.TableDef
+    Dim tds As DAO.TableDefs
+        
+    Dim db As DAO.Database
+    Set db = CurrentDb()
+    
+    dirpath = joinpaths(source_dir(), "tbldefs\")
+    mktree dirpath
+    
+    logger "ExportTblDefs", "INFO", "Export tabledefs"
+    logger "ExportTblDefs", "DEBUG", "> export to: " & dirpath
+    logger "ExportTblDefs", "DEBUG", "> Newer only: " & newer_only
+    
+    Set tds = db.TableDefs
+    count = 0
+    If newer_only Then
+        total = UBound(Split(list_to_export(acTable), ";")) + 1
+    Else
+        total = tds.count
+    End If
+
+    For Each td In tds
+
+        If Left$(td.name, 1) = "~" Or Left$(td.name, 4) = "MSys" Then
+            logger "ExportAllTblDefs", "DEBUG", "tables: " & td.name & " ignored"
+            GoTo next_td
+        End If
+
+        If newer_only Then
+            If Not needs_export(acTable, td.name) > 0 Then
+                logger "ExportAllTblDefs", "DEBUG", "tables: " & td.name & " skipped"
+                GoTo next_td
+            End If
+        End If
+
+        If Len(td.connect) = 0 Then ' this is not an external table
+            ExportTableDef CurrentDb, td, dirpath
+        Else
+            ExportLinkedTable td.name, dirpath
+        End If
+        
+        count = count + 1
+        Call SysCmd(4, "Export table definition: " & count & " on " & total)
+next_td:
+    Next
+    
+    Call SysCmd(acSysCmdClearStatus)
+    logger "ExportAllTblDefs", "INFO", "> " & count & " tbldefs exported"
+    
+End Sub
+
+Public Sub ExportAllTableDatas()
+    Dim dirpath, include_tables As String
+    Dim count, total As Integer
+    Dim td As DAO.TableDef
+    
+    dirpath = joinpaths(source_dir(), "tables\")
+    mktree dirpath
+    
+    logger "ExportTableDatas", "INFO", "Export table's data"
+    logger "ExportTableDatas", "DEBUG", "> export to: " & dirpath
+    
+
+    count = 0
+    
+    include_tables = get_include_tables()
+    count = 0
+    total = UBound(Split(include_tables, ",")) + 1
+    
+    Dim IncludeTablesCol As Collection
+    Set IncludeTablesCol = StrSetToCol(include_tables, ",")
+    
+    For Each td In CurrentDb.TableDefs()
+        
+        If InCollection(IncludeTablesCol, td.name) Or include_tables = "*" Then
+        
+            If Len(td.connect) <> 0 Then ' this is not an external table
+                logger "ExportTableDatas", "ERROR", td.name & " >> You can't export data from a linked table"
+                GoTo next_td
+            End If
+
+            ExportTableData CStr(td.name), dirpath
+            count = count + 1
+
+            Call SysCmd(4, "Export table's data: " & count & " on " & total)
+            
+        End If
+        
+next_td:
+    Next
+    
+    Call SysCmd(acSysCmdClearStatus)
+    logger "ExportTableDatas", "INFO", "> " & count & " table's datas exported"
+End Sub
+
+Public Sub ExportAllRelations()
+    Dim dirpath, filepath As String
+    Dim count, total As Integer
+    
+    dirpath = joinpaths(source_dir(), "relations\")
+    mktree dirpath
+    
+    logger "ExportRelations", "INFO", "Export relations"
+    logger "ExportRelations", "DEBUG", "> export to: " & dirpath
+    
+    count = 0
+
+    Dim aRelation As DAO.Relation
+    
+    total = CurrentDb.Relations.count
+    
+    For Each aRelation In CurrentDb.Relations
+    
+        ' Exclude relations from system tables and inherited (linked) relations
+        If Not (aRelation.name = "MSysNavPaneGroupsMSysNavPaneGroupToObjects" _
+                Or aRelation.name = "MSysNavPaneGroupCategoriesMSysNavPaneGroups" _
+                Or (aRelation.Attributes And DAO.RelationAttributeEnum.dbRelationInherited) = _
+                DAO.RelationAttributeEnum.dbRelationInherited) Then
+            
+            filepath = joinpaths(dirpath, to_filename(aRelation.name) & ".txt")
+            
+            ExportRelation aRelation, filepath
+            
+            count = count + 1
+            
+            Call SysCmd(4, "Export relation: " & count & " on " & total)
+        End If
+    Next
+    
+    Call SysCmd(acSysCmdClearStatus)
+    logger "ExportAllSource", "INFO", "> " & count & " relations exported"
+    
+    
+End Sub

+ 379 - 0
source/modules/OA_Import.bas

@@ -0,0 +1,379 @@
+Option Compare Database
+Option Explicit
+
+Public Sub ImportAll()
+    Dim db As DAO.Database
+    Dim FSO As Object
+
+    logger "ImportAll", "INFO", "Begin 'Import all sources'"
+    
+    Set FSO = CreateObject("Scripting.FileSystemObject")
+    Set db = CurrentDb
+
+    If Not FSO.FolderExists(source_dir()) Then
+        logger "ImportAll", "CRITICAL", "No source found at:" & source_dir
+    End If
+
+    ' close any opened form or report, except OpenAccess's form
+    Call CloseFormsReports
+
+    ' import database properties
+    Call ImportProperties(CurrentDb, joinpaths(source_dir, "database.properties"))
+
+    Call ImportAllQueries
+    
+    Call ImportAllTblDefs
+    Call ImportAllTableDatas
+    Call ImportAllDataMacros
+    
+    Call ImportAllDocs(acForm)
+    
+    Call ImportAllDocs(acReport)
+    Call ImportAllPrintVars
+    
+    Call ImportAllDocs(acMacro)
+    
+    Call ImportReferences
+    Call ImportAllDocs(acModule)
+    
+    Call ImportAllRelations
+
+    SaveProject
+    
+    logger "ImportAll", "INFO", "Import done"
+
+End Sub
+
+Public Sub ImportAllQueries()
+
+    Dim dirpath, obj_name As String
+    Dim filename As Variant
+    Dim count, total As Integer
+
+    
+    dirpath = joinpaths(source_dir(), "queries\")
+    
+    logger "ImportAllQueries", "INFO", "Import queries"
+    logger "ImportAllQueries", "DEBUG", "> import from: " & dirpath
+
+    count = 0
+    total = 0
+    
+    Dim to_import As String
+    to_import = list_files_in(dirpath, "*.bas")
+    total = UBound(Split(to_import, "|")) + 1
+    
+    If Len(to_import) > 0 Then
+        For Each filename In Split(to_import, "|")
+            
+            obj_name = Mid$(filename, 1, InStrRev(filename, ".") - 1)
+            obj_name = to_accessname(obj_name)
+            
+            ImportDocument acQuery, obj_name, joinpaths(dirpath, filename)
+            
+            count = count + 1
+            Call SysCmd(acSysCmdSetStatus, "Import query: " & count & " on " & total)
+            
+            filename = dir$()
+        Next filename
+        
+        logger "ImportAllQueries", "INFO", "> " & count & " queries imported"
+        
+    Else
+        logger "ImportAllQueries", "INFO", "> No query to import"
+    End If
+    
+    Call SysCmd(acSysCmdClearStatus)
+    
+End Sub
+
+Public Sub ImportAllTblDefs()
+    Dim dirpath, obj_name As String
+    Dim filename As Variant
+    Dim count, total As Integer
+    
+    dirpath = joinpaths(source_dir(), "tbldefs\")
+    
+    logger "ImportAllTblDefs", "INFO", "Import table defs"
+    logger "ImportAllTblDefs", "DEBUG", "> import from: " & dirpath
+    
+    count = 0
+    total = 0
+    
+    Dim to_import As String
+    to_import = list_files_in(dirpath, "*.sql")
+    total = UBound(Split(to_import, "|")) + 1
+    
+    If Len(to_import) > 0 Then
+        For Each filename In Split(to_import, "|")
+        
+            obj_name = Mid$(filename, 1, InStrRev(filename, ".") - 1)
+            obj_name = to_accessname(obj_name)
+            
+            ImportTableDef CStr(obj_name), dirpath
+            
+            count = count + 1
+            Call SysCmd(acSysCmdSetStatus, "Import tabledef: " & count & " on " & total)
+            
+        Next filename
+        
+        logger "ImportAllTblDefs", "INFO", "> " & count & " TblDefs imported"
+    Else
+        logger "ImportAllTblDefs", "INFO", "> No tabledef to import"
+    End If
+    
+    Call SysCmd(acSysCmdClearStatus)
+    
+End Sub
+
+Public Sub ImportAllLinkedTables()
+    Dim dirpath, obj_name As String
+    Dim filename As Variant
+    Dim count, total As Integer
+    
+    dirpath = joinpaths(source_dir(), "tbldef\")
+    
+    logger "ImportAllLinkedTables", "INFO", "Import linked tables"
+    logger "ImportAllLinkedTables", "DEBUG", "> import from: " & dirpath
+    
+    count = 0
+    total = 0
+    
+    Dim to_import As String
+    to_import = list_files_in(dirpath, "*.LNKD")
+    total = UBound(Split(to_import, "|")) + 1
+    
+    If Len(to_import) > 0 Then
+        For Each filename In Split(to_import, "|")
+        
+            obj_name = Mid$(filename, 1, InStrRev(filename, ".") - 1)
+            obj_name = to_accessname(obj_name)
+            
+            ImportLinkedTable CStr(obj_name), dirpath
+            
+            count = count + 1
+            Call SysCmd(acSysCmdSetStatus, "Import linked table: " & count & " on " & total)
+            
+        Next filename
+        
+        logger "ImportAllLinkedTables", "INFO", "> " & count & " Linked TblDefs imported"
+
+    Else
+        logger "ImportAllLinkedTables", "INFO", "> No linked table to import"
+    End If
+
+    Call SysCmd(acSysCmdClearStatus)
+    
+End Sub
+
+
+Public Sub ImportAllTableDatas()
+    Dim dirpath, obj_name As String
+    Dim filename As Variant
+    Dim count, total As Integer
+    
+    dirpath = joinpaths(source_dir(), "tables\")
+    
+    logger "ImportAllTableDatas", "INFO", "Import table datas"
+    logger "ImportAllTableDatas", "DEBUG", "> import from: " & dirpath
+    
+    count = 0
+    total = 0
+    
+    Dim to_import As String
+    to_import = list_files_in(dirpath, "*.txt")
+    total = UBound(Split(to_import, "|")) + 1
+
+    If Len(to_import) > 0 Then
+        For Each filename In Split(to_import, "|")
+        
+            obj_name = Mid$(filename, 1, InStrRev(filename, ".") - 1)
+            obj_name = to_accessname(obj_name)
+            
+            ImportTableData CStr(obj_name), dirpath
+            
+            count = count + 1
+            Call SysCmd(acSysCmdSetStatus, "Import table data: " & count & " on " & total)
+            
+        Next filename
+        
+        logger "ImportAllTableDatas", "INFO", "> " & count & " table's data imported"
+    Else
+        logger "ImportAllTableDatas", "INFO", "> " & count & " table's data imported"
+    End If
+
+    Call SysCmd(acSysCmdClearStatus)
+
+End Sub
+
+Public Sub ImportAllDataMacros()
+    Dim dirpath, obj_name As String
+    Dim filename As Variant
+    Dim count, total As Integer
+    
+    dirpath = joinpaths(source_dir(), "tbldef\")
+    
+    logger "ImportAllDataMacros", "INFO", "Import DataMacros"
+    logger "ImportAllDataMacros", "DEBUG", "> import from: " & dirpath
+    
+    count = 0
+    total = 0
+
+    Dim to_import As String
+    to_import = list_files_in(dirpath, "*.xml")
+    total = UBound(Split(to_import, "|")) + 1
+
+    If Len(to_import) > 0 Then
+        For Each filename In Split(to_import, "|")
+            
+            obj_name = Mid$(filename, 1, InStrRev(filename, ".") - 1)
+            obj_name = to_accessname(obj_name)
+
+            ImportDataMacros obj_name, dirpath
+            Call SysCmd(acSysCmdSetStatus, "Import DataMacro: " & count & " on " & total)
+            
+            count = count + 1
+            
+        Next filename
+        
+        logger "ImportAllDataMacros", "INFO", "> " & count & " DataMacros imported"
+    Else
+        logger "ImportAllDataMacros", "INFO", "> " & count & " DataMacros imported"
+    End If
+
+    Call SysCmd(acSysCmdClearStatus)
+    
+End Sub
+
+
+Public Sub ImportAllDocs(ByVal acType As Integer, Optional ByVal encoding = "utf-8")
+
+    Dim doc_label As String
+    Dim dirpath, obj_name As String
+    Dim filename As Variant
+    Dim count, total As Integer
+    
+
+    'get the document's container's name from it's type
+    doc_label = get_container_name(acType)
+    If Len(doc_label) = 0 Then
+        logger "ImportAllDocs", "CRITICAL", "acType " & acType & " is not recognized!"
+        Exit Sub
+    End If
+    
+    dirpath = joinpaths(source_dir(), doc_label & "\")
+
+    logger "ImportAllDocs", "INFO", "# Import " & doc_label
+    logger "ImportAllDocs", "DEBUG", "> import from: " & dirpath
+
+    count = 0
+    total = 0
+
+    Dim to_import As String
+    to_import = list_files_in(dirpath, "*.bas")
+    total = UBound(Split(to_import, "|")) + 1
+
+    If Len(to_import) > 0 Then
+        For Each filename In Split(to_import, "|")
+            
+            obj_name = Mid$(filename, 1, InStrRev(filename, ".") - 1)
+            obj_name = to_accessname(obj_name)
+            
+            If IsNotVCS(obj_name) Then
+            
+                ImportDocument acType, obj_name, joinpaths(dirpath, filename)
+
+            Else
+
+                logger "ImportAllDocs", "WARNING", "Module " & obj_name & " could not be updated while running. Ensure latest version is included!"
+
+            End If
+            
+            count = count + 1
+            Call SysCmd(acSysCmdSetStatus, "Import " & doc_label & ": " & count & " on " & total)
+            
+        Next filename
+        
+        logger "ImportAllDocs", "INFO", "> " & count & " " & doc_label & " imported"
+    Else
+        logger "ImportAllDocs", "INFO", "> No " & doc_label & " to import"
+    End If
+
+    Call SysCmd(acSysCmdClearStatus)
+
+End Sub
+
+Public Sub ImportAllPrintVars()
+    Dim dirpath, obj_name As String
+    Dim filename As Variant
+    Dim count, total As Integer
+    
+    dirpath = joinpaths(source_dir(), "reports\")
+    
+    logger "ImportAllPrintVars", "INFO", "Import Print Vars"
+    logger "ImportAllPrintVars", "DEBUG", "> import from: " & dirpath
+    
+    count = 0
+    total = 0
+    
+    Dim to_import As String
+    to_import = list_files_in(dirpath, "*.pv")
+    total = UBound(Split(to_import, "|")) + 1
+    
+    If Len(to_import) > 0 Then
+        For Each filename In Split(to_import, "|")
+
+            obj_name = Mid$(filename, 1, InStrRev(filename, ".") - 1)
+            obj_name = to_accessname(obj_name)
+            
+            ImportPrintVars obj_name, joinpaths(dirpath, filename)
+            
+            count = count + 1
+            Call SysCmd(acSysCmdSetStatus, "Import Print Vars: " & count & " on " & total)
+            
+        Next filename
+        logger "ImportAllPrintVars", "INFO", "> " & count & " Print Vars imported"
+    Else
+        logger "ImportAllPrintVars", "INFO", "> No Print Vars to import"
+    End If
+
+    Call SysCmd(acSysCmdClearStatus)
+
+End Sub
+
+Public Sub ImportAllRelations()
+    Dim dirpath As String
+    Dim filename As Variant
+    Dim count, total As Integer
+    
+    
+    dirpath = joinpaths(source_dir(), "relations\")
+    
+    logger "ImportAllRelations", "INFO", "Import Relations"
+    logger "ImportAllRelations", "DEBUG", "> import from: " & dirpath
+    
+    count = 0
+    total = 0
+    
+    Dim to_import As String
+    to_import = list_files_in(dirpath, "*.txt")
+    total = UBound(Split(to_import, "|")) + 1
+    
+    If Len(to_import) > 0 Then
+        For Each filename In Split(to_import, "|")
+            
+            ImportRelation joinpaths(dirpath, filename)
+            
+            count = count + 1
+            Call SysCmd(acSysCmdSetStatus, "Import relation: " & count & " on " & total)
+            
+        Next filename
+        
+        logger "ImportAllRelations", "INFO", "> " & count & " Relations imported"
+    Else
+        logger "ImportAllRelations", "INFO", "> No relation to import"
+    End If
+
+    Call SysCmd(acSysCmdClearStatus)
+
+End Sub

+ 8 - 2
source/modules/OA_Log.bas

@@ -3,9 +3,14 @@ Option Explicit
 
 
 Dim log_file_path As String
 Dim log_file_path As String
 Dim debug_level As Boolean
 Dim debug_level As Boolean
+Dim p_errors_occured As Boolean
+
+Public Function errors_occured() As Boolean
+    errors_occured = p_errors_occured
+End Function
 
 
 Private Sub MkLogDir()
 Private Sub MkLogDir()
-    Call RecursiveMkDir(Environ("AppData") & "\OpenAccess\log\")
+    mktree joinpaths(Environ("AppData"), "\OpenAccess\log\")
 End Sub
 End Sub
 
 
 Public Function log_dir() As String
 Public Function log_dir() As String
@@ -38,7 +43,6 @@ Public Sub set_log_path(ByVal path As String)
 End Sub
 End Sub
 
 
 
 
-
 Public Sub logger(ByVal origin As String, ByVal level As String, ByVal msg As String)
 Public Sub logger(ByVal origin As String, ByVal level As String, ByVal msg As String)
     Dim FSO As Object
     Dim FSO As Object
     Dim oFile As Object
     Dim oFile As Object
@@ -48,6 +52,8 @@ Public Sub logger(ByVal origin As String, ByVal level As String, ByVal msg As St
     
     
     If level = "DEBUG" And Not debug_level = True Then Exit Sub
     If level = "DEBUG" And Not debug_level = True Then Exit Sub
 
 
+    If level = "ERROR" Then p_errors_occured = True
+
     Set FSO = CreateObject("Scripting.FileSystemObject")
     Set FSO = CreateObject("Scripting.FileSystemObject")
 
 
     If Not Len(log_file_path) > 0 Then
     If Not Len(log_file_path) > 0 Then

+ 23 - 11
source/modules/OA_Main.bas

@@ -1,4 +1,5 @@
 Option Compare Database
 Option Compare Database
+Option Explicit
 
 
 '****
 '****
 '*
 '*
@@ -8,6 +9,7 @@ Option Compare Database
 Public Const opInterrupted = 10
 Public Const opInterrupted = 10
 Public Const opCancelled = 11
 Public Const opCancelled = 11
 Public Const opCompleted = 12
 Public Const opCompleted = 12
+Public Const opCompletedWithErrors = 13
 
 
 Dim debug_mode As Boolean
 Dim debug_mode As Boolean
 Public Sub activate_debug_mode()
 Public Sub activate_debug_mode()
@@ -50,9 +52,10 @@ Dim step As String
     End If
     End If
     
     
     ' run the export
     ' run the export
-    step = "Run VCS Export"
+    step = "Run Open Access Export"
     logger "make_sources", "INFO", step
     logger "make_sources", "INFO", step
-    Call ExportAllSource
+    
+    Call ExportAll
 
 
     ' new sources date
     ' new sources date
     step = "Updates sources date"
     step = "Updates sources date"
@@ -60,16 +63,22 @@ Dim step As String
     Call update_sources_date
     Call update_sources_date
 
 
     ' cleans the obsolete files (see CleanDirs in optimizer)
     ' cleans the obsolete files (see CleanDirs in optimizer)
+    Dim msg As String
     msg = CleanDirs(True)
     msg = CleanDirs(True)
     If Len(msg) > 0 Then
     If Len(msg) > 0 Then
-        msg = "Following objects do not exist anymore, do you want to delete treir source files?" & vbNewLine & _
+        msg = "# CLEANING # " & vbNewLine & "Following objects do not exist anymore, do you want to DELETE their source FILES?" & vbNewLine & _
           "" & msg
           "" & msg
-        If OA_MsgBox(msg, vbYesNo, "Cleaning") = vbYes Then
+        If OA_MsgBox(msg, vbYesNo, "Cleaning Source Files") = vbYes Then
             Call CleanDirs
             Call CleanDirs
         End If
         End If
     End If
     End If
 
 
-    make_sources = opCompleted
+    If errors_occured() Then
+        make_sources = opCompletedWithErrors
+    Else
+        make_sources = opCompleted
+    End If
+    
     Exit Function
     Exit Function
     
     
 err:
 err:
@@ -78,8 +87,6 @@ err:
         logger "make_sources", "ERROR", "Unknown error at: " & step & " - " & err.Description & "(#" & err.Number & ")"
         logger "make_sources", "ERROR", "Unknown error at: " & step & " - " & err.Description & "(#" & err.Number & ")"
     End If
     End If
     
     
-    Call update_oa_param("sources_date", CStr(old_sources_date))
-    
     Exit Function
     Exit Function
 cancelOp:
 cancelOp:
     make_sources = opCancelled
     make_sources = opCancelled
@@ -113,9 +120,10 @@ Public Function update_from_sources(Optional ByVal backup As Boolean) As Integer
         GoTo cancelOp
         GoTo cancelOp
     End If
     End If
 
 
-    step = "Run VCS Import"
+    step = "Run Open Access Import"
     logger "update_from_sources", "INFO", step
     logger "update_from_sources", "INFO", step
-    Call ImportAllSource
+    
+    Call ImportAll
    
    
     step = "Cleaning obsolete objects in app"
     step = "Cleaning obsolete objects in app"
     
     
@@ -133,12 +141,16 @@ Public Function update_from_sources(Optional ByVal backup As Boolean) As Integer
     logger "update_from_sources", "INFO", step
     logger "update_from_sources", "INFO", step
     Call update_sources_date
     Call update_sources_date
     
     
-    update_from_sources = opCompleted
+    If errors_occured() Then
+        update_from_sources = opCompletedWithErrors
+    Else
+        update_from_sources = opCompleted
+    End If
     Exit Function
     Exit Function
 err:
 err:
     OA_MsgBox "Unknown error - " & err.Description & " (#" & err.Number & ")" & vbNewLine & "See the log file for more information", vbCritical, "CRITICAL ERROR"
     OA_MsgBox "Unknown error - " & err.Description & " (#" & err.Number & ")" & vbNewLine & "See the log file for more information", vbCritical, "CRITICAL ERROR"
     If err.Number <> "60000" Then
     If err.Number <> "60000" Then
-        logger "update_from_sources", "CRITICAL", "Unknown error at: " & step & " - " & err.Description & "(#" & err.Number & ")"
+        logger "update_from_sources", "ERROR", "Unknown error at: " & step & " - " & err.Description & "(#" & err.Number & ")"
     End If
     End If
     
     
     Exit Function
     Exit Function

+ 7 - 2
source/modules/OA_Msg.bas

@@ -1,4 +1,7 @@
 Option Compare Database
 Option Compare Database
+Option Private Module
+Option Explicit
+
 Dim p_SilentMode As Boolean
 Dim p_SilentMode As Boolean
 
 
 Public Sub activate_SilentMode()
 Public Sub activate_SilentMode()
@@ -47,7 +50,8 @@ End Function
 
 
 
 
 Public Function prompt_for_export_confirmation() As Boolean
 Public Function prompt_for_export_confirmation() As Boolean
-
+    Dim msg As String
+    
     msg = "****   OPENACCESS EXPORT   ****" & vbNewLine & _
     msg = "****   OPENACCESS EXPORT   ****" & vbNewLine & _
           "You're going to export the following:" & vbNewLine & vbNewLine & _
           "You're going to export the following:" & vbNewLine & vbNewLine & _
           msg_list_to_export() & _
           msg_list_to_export() & _
@@ -59,7 +63,8 @@ End Function
 
 
 
 
 Public Function prompt_for_import_confirmation() As Boolean
 Public Function prompt_for_import_confirmation() As Boolean
-
+    Dim msg As String
+    
     msg = "****   OPENACCESS IMPORT   ****" & vbNewLine & _
     msg = "****   OPENACCESS IMPORT   ****" & vbNewLine & _
           "You're going to update " & UCase(CurrentProject.name) & " with the sources files" & vbNewLine & vbNewLine & _
           "You're going to update " & UCase(CurrentProject.name) & " with the sources files" & vbNewLine & vbNewLine & _
           "WARNING: Any non exported work would be lost!"
           "WARNING: Any non exported work would be lost!"

+ 7 - 6
source/modules/OA_Optimizer.bas

@@ -1,4 +1,5 @@
 Option Compare Database
 Option Compare Database
+Option Private Module
 Option Explicit
 Option Explicit
 
 
 '****
 '****
@@ -186,7 +187,7 @@ Public Function msg_list_to_export() As String
         msg_list_to_export = msg_list_to_export & "> DATA: (more than 5)" & vbNewLine
         msg_list_to_export = msg_list_to_export & "> DATA: (more than 5)" & vbNewLine
     End If
     End If
     
     
-    msg_list_to_export = msg_list_to_export & "> RELATIONS, DB PROPERTIES"
+    msg_list_to_export = msg_list_to_export & "> RELATIONS" & vbNewLine & "> REFERENCES" & vbNewLine & "> DB PROPERTIES"
     
     
 End Function
 End Function
 '******
 '******
@@ -220,7 +221,7 @@ Public Function CleanDirs(Optional ByVal sim As Boolean = False)
     CleanDirs = ""
     CleanDirs = ""
     
     
     Dim source_path As String
     Dim source_path As String
-    source_path = VCS_Dir.ProjectPath() & "source\"
+    source_path = source_dir()
     
     
     logger "CleanDirs", "INFO", "Optimizer ON: cleans the directories from " & source_path
     logger "CleanDirs", "INFO", "Optimizer ON: cleans the directories from " & source_path
     
     
@@ -295,7 +296,7 @@ End Function
 Public Function files_exist_for(acType As Integer, name As String) As Boolean
 Public Function files_exist_for(acType As Integer, name As String) As Boolean
 'does the object has its files in sources
 'does the object has its files in sources
     Dim source_path As String
     Dim source_path As String
-    source_path = VCS_Dir.ProjectPath() & "source\"
+    source_path = source_dir()
     
     
     name = to_filename(name)
     name = to_filename(name)
     
     
@@ -314,13 +315,13 @@ Public Function files_exist_for(acType As Integer, name As String) As Boolean
         Case acTable
         Case acTable
             
             
             files_exist_for = ( _
             files_exist_for = ( _
-                                 dir(source_path & "tbldef\" & name & ".sql") <> "" _
+                                 dir(source_path & "tbldefs\" & name & ".sql") <> "" _
                                  Or _
                                  Or _
-                                 dir(source_path & "tbldef\" & name & ".lnkd") <> "" _
+                                 dir(source_path & "tbldefs\" & name & ".lnkd") <> "" _
                                )
                                )
         
         
         Case acMacro
         Case acMacro
-            files_exist_for = (dir(source_path & "macros\" & name & ".bas") <> "")
+            files_exist_for = (dir(source_path & "scripts\" & name & ".bas") <> "")
         
         
         Case acModule
         Case acModule
             files_exist_for = (dir(source_path & "modules\" & name & ".bas") <> "")
             files_exist_for = (dir(source_path & "modules\" & name & ".bas") <> "")

+ 144 - 0
source/modules/OA_Path.bas

@@ -0,0 +1,144 @@
+Option Compare Database
+Option Private Module
+Option Explicit
+
+'operations on directories and path
+
+Public Function norm_dir_path(ByVal dir_path As String) As String
+    
+    dir_path = Replace(dir_path, "/", "\")
+    dir_path = Replace(dir_path, "\\", "\")
+    If Right(dir_path, 1) <> "\" Then dir_path = dir_path & "\"
+    norm_dir_path = dir_path
+
+End Function
+
+Public Sub mktree(ByVal dirpath As String)
+'recursively create the directory if it does not exist
+    On Error GoTo err
+    Dim path_part, current_path As String
+    current_path = ""
+    dirpath = norm_dir_path(dirpath)
+    
+    If dir(dirpath, vbDirectory) <> "" Then Exit Sub
+    
+    For Each path_part In Split(dirpath, "\")
+        If Len(path_part) > 0 Then
+            current_path = current_path & path_part & "\"
+            If dir(current_path, vbDirectory) = "" Then
+                MkDir current_path
+            End If
+        End If
+    Next path_part
+    
+    logger "MkDirIfNotExist", "INFO", "New dir created: " & dirpath
+    Exit Sub
+err:
+    If err.Number = 75 Then
+        'dir already exist
+    Else
+        logger "MkDirIfNotExist", "ERROR", "Unable to create directory " & dirpath & " : " & err.Description
+    End If
+End Sub
+
+
+Public Function parent_dir(path As String) As String
+    'parent_dir = Left(path, InStrRev(path, "\", Len(path) - 1))
+    parent_dir = CreateObject("Scripting.FileSystemObject").GetParentFolderName(path)
+End Function
+
+Public Function joinpaths(ByVal path1 As String, ByVal path2 As String) As String
+
+    joinpaths = norm_dir_path(path1) & path2
+
+End Function
+
+Public Function to_filename(ByVal object_name As String) As String
+    ' return a file name for the object's name
+    ' 1- access does not accept brackets for object's names
+    ' 2- file's names can not contain those caracters:
+    ' \ [92]
+    ' / [47]
+    ' : [58]
+    ' * [42]
+    ' ? [63]
+    ' " [34]
+    ' < [60]
+    ' > [62]
+    ' | [124]
+    '
+    ' this function replaces caracters which are not allowed for file names by [x],
+    'where x is the ascii code of the character
+    ' test: "test_\_/_:_*_?_""_<_>_|" should become test_[92]_[47]_[58]_[42]_[63]_[34]_[60]_[62]_[124]
+    ' to convert back the string, use to_accessname
+    
+    Dim result As String
+    Dim ascii_code As Variant
+    
+    result = object_name
+    
+    For Each ascii_code In Split(ForbiddenCars, ",")
+        result = Replace(result, Chr(CInt(ascii_code)), "[" & ascii_code & "]")
+    Next
+
+    If result <> object_name Then
+        logger "to_filename", "DEBUG", "> Object's name " & object_name & " transformed to " & result
+    End If
+
+    to_filename = result
+    Exit Function
+err:
+    Call logger("to_filename", "ERROR", "Unable to convert object's name " & object_name & " to file's name")
+    to_filename = object_name
+End Function
+
+Public Function to_accessname(ByVal file_name As String) As String
+    On Error GoTo err
+    ' return an object name from a file's name
+    ' see function 'to_filename' for more informations
+    ' test: "test_[92]_[47]_[58]_[42]_[63]_[34]_[60]_[62]_[124]" should become test_\_/_:_*_?_"_<_>_|
+
+    Dim result As String
+    Dim ascii_code As Variant
+    
+    result = file_name
+    
+    For Each ascii_code In Split(ForbiddenCars, ",")
+        result = Replace(result, "[" & ascii_code & "]", Chr(CInt(ascii_code)))
+    Next
+
+    If result <> file_name Then
+        logger "to_accessname", "DEBUG", "> File's name " & file_name & " transformed to " & result
+    End If
+
+    to_accessname = result
+    Exit Function
+err:
+    Call logger("to_accessname", "ERROR", "Unable to convert file's name " & file_name & " to access object's name")
+    to_accessname = file_name
+End Function
+
+Public Sub del_if_exist(ByVal path As String)
+'delete a file if it exists
+    If dir(path) <> "" Then
+        Kill path
+    End If
+End Sub
+
+Public Function list_files_in(ByVal dirpath As String, Optional ByVal filter As String = "")
+    Dim filename As String
+    list_files_in = ""
+    
+    dirpath = norm_dir_path(dirpath)
+    
+    filename = dir$(dirpath & filter)
+    
+    Do Until Len(filename) = 0
+        If Len(list_files_in) > 0 Then list_files_in = list_files_in & "|"
+        
+        list_files_in = list_files_in & filename
+        
+        filename = dir$()
+    Loop
+    
+End Function

+ 1 - 0
source/modules/OA_Properties.bas

@@ -1,4 +1,5 @@
 Option Compare Database
 Option Compare Database
+Option Private Module
 Option Explicit
 Option Explicit
 
 
 '****
 '****

+ 2 - 0
source/modules/OA_Shell.bas

@@ -1,4 +1,6 @@
 Option Compare Database
 Option Compare Database
+Option Private Module
+Option Explicit
 
 
 '****
 '****
 '*
 '*

+ 5 - 2
source/modules/OA_Utils.bas

@@ -1,4 +1,6 @@
 Option Compare Database
 Option Compare Database
+Option Private Module
+Option Explicit
 
 
 Public Function oa_tbl_exists() As Boolean
 Public Function oa_tbl_exists() As Boolean
 ' return True if the 'USysOpenAccess' table exists
 ' return True if the 'USysOpenAccess' table exists
@@ -60,7 +62,7 @@ End Function
 
 
 Public Function IsInArray(ByVal stringToBeFound As String, ByRef arr As Variant) As Boolean
 Public Function IsInArray(ByVal stringToBeFound As String, ByRef arr As Variant) As Boolean
 ' returns True if the string is in the array
 ' returns True if the string is in the array
-    IsInArray = (UBound(Filter(arr, stringToBeFound)) > -1)
+    IsInArray = (UBound(filter(arr, stringToBeFound)) > -1)
 End Function
 End Function
 
 
 Public Function msys_type_filter(acType) As String
 Public Function msys_type_filter(acType) As String
@@ -128,8 +130,9 @@ Public Function complete_gitignore()
 ' creates or complete the .gitignore file of the repo
 ' creates or complete the .gitignore file of the repo
 
 
     Dim gitignore_path, str_existing_keys, str As String
     Dim gitignore_path, str_existing_keys, str As String
-    
+    Dim key As Variant
     Dim keys() As String
     Dim keys() As String
+    
     keys = Split("*.accdb;*.laccdb;*.mdb;*.ldb;*.accde;*.mde;*.accda", ";")
     keys = Split("*.accdb;*.laccdb;*.mdb;*.ldb;*.accde;*.mde;*.accda", ";")
     
     
     gitignore_path = CurrentProject.path & "\.gitignore"
     gitignore_path = CurrentProject.path & "\.gitignore"

+ 3 - 3
source/modules/VCS_DataMacro.bas

@@ -1,5 +1,4 @@
 Option Compare Database
 Option Compare Database
-
 Option Private Module
 Option Private Module
 Option Explicit
 Option Explicit
 
 
@@ -13,9 +12,10 @@ Public Sub ExportDataMacros(ByVal tableName As String, ByVal directory As String
     On Error GoTo Err_export
     On Error GoTo Err_export
     Dim filepath As String
     Dim filepath As String
     
     
+    mktree directory
     filepath = directory & to_filename(tableName) & ".xml"
     filepath = directory & to_filename(tableName) & ".xml"
 
 
-    VCS_IE_Functions.ExportObject acTableDataMacro, tableName, filepath, VCS_File.UsingUcs2
+    ExportDocument acTableDataMacro, tableName, filepath
     FormatDataMacro filepath
     FormatDataMacro filepath
 
 
     Exit Sub
     Exit Sub
@@ -29,7 +29,7 @@ Public Sub ImportDataMacros(ByVal tableName As String, ByVal directory As String
     Dim filepath As String
     Dim filepath As String
     
     
     filepath = directory & to_filename(tableName) & ".xml"
     filepath = directory & to_filename(tableName) & ".xml"
-    VCS_IE_Functions.ImportObject acTableDataMacro, tableName, filepath, VCS_File.UsingUcs2
+    ImportDocument acTableDataMacro, tableName, filepath
     
     
     Exit Sub
     Exit Sub
     
     

+ 2 - 134
source/modules/VCS_Dir.bas

@@ -14,17 +14,6 @@ Option Explicit
         ErrInvalidCharactersInPath
         ErrInvalidCharactersInPath
     End Enum
     End Enum
     Const MAX_PATH = 260
     Const MAX_PATH = 260
-    
-' Path/Directory of the current database file.
-Public Function ProjectPath() As String
-    ProjectPath = CurrentProject.path
-    If Right$(ProjectPath, 1) <> "\" Then ProjectPath = ProjectPath & "\"
-End Function
-
-' Path/Directory for source files
-Public Function SourcePath() As String
-    SourcePath = ProjectPath & CurrentProject.name & ".src\"
-End Function
 
 
 ' Create folder `Path`. Silently do nothing if it already exists.
 ' Create folder `Path`. Silently do nothing if it already exists.
 Public Sub MkDirIfNotExist(ByVal path As String)
 Public Sub MkDirIfNotExist(ByVal path As String)
@@ -35,44 +24,15 @@ MkDirIfNotexist_noop:
     On Error GoTo 0
     On Error GoTo 0
 End Sub
 End Sub
 
 
-
-
 ' Delete a file if it exists.
 ' Delete a file if it exists.
 Public Sub DelIfExist(ByVal path As String)
 Public Sub DelIfExist(ByVal path As String)
     On Error GoTo DelIfNotExist_Noop
     On Error GoTo DelIfNotExist_Noop
     Kill path
     Kill path
-    logger "DelIfExist", "DEBUG", "Killed: " & path
+    'logger "DelIfExist", "DEBUG", "Killed: " & path
 DelIfNotExist_Noop:
 DelIfNotExist_Noop:
     On Error GoTo 0
     On Error GoTo 0
 End Sub
 End Sub
 
 
-' Erase all *.`ext` files in `Path`.
-Public Sub ClearTextFilesFromDir(ByVal path As String, ByVal Ext As String, Optional ByVal force As Boolean = False)
-    
-    '### 13/10/2016: add optimizer
-    ' we don't want to clear the text files of the objects which will not be exported
-    'BUT we still want to clear obsolete files: see CleanDirs in optimizer
-    If optimizer_activated() And Not force Then
-        logger "ClearTextFilesFromDir", "INFO", "Optimizer on: sub aborted"
-        Exit Sub
-    End If
-    '###
-    
-    logger "ClearTextFilesFromDir", "DEBUG", "Clear dir: " & path & "*." & Ext
-
-    Dim FSO As Object
-    Set FSO = CreateObject("Scripting.FileSystemObject")
-    If Not FSO.FolderExists(path) Then Exit Sub
-
-    On Error GoTo ClearTextFilesFromDir_noop
-    If dir$(path & "*." & Ext) <> vbNullString Then
-        FSO.DeleteFile path & "*." & Ext
-    End If
-    
-ClearTextFilesFromDir_noop:
-    On Error GoTo 0
-End Sub
-
 Public Function DirExists(ByVal strPath As String) As Boolean
 Public Function DirExists(ByVal strPath As String) As Boolean
     On Error Resume Next
     On Error Resume Next
     DirExists = False
     DirExists = False
@@ -85,96 +45,4 @@ Public Function FileExists(ByVal strPath As String) As Boolean
     FileExists = ((GetAttr(strPath) And vbDirectory) <> vbDirectory)
     FileExists = ((GetAttr(strPath) And vbDirectory) <> vbDirectory)
 End Function
 End Function
 
 
-
-
-    
-Function RecursiveMkDir(ByVal PathSpec As String) As EMakeDirStatus
-    ' This function creates a series of nested directories. The parent of
-    ' every directory is create before a subdirectory is created, allowing a
-    ' folder path specification of any number of directories (as long as the
-    ' total length is less than MAX_PATH.
-    
-    Dim FSO As Scripting.FileSystemObject
-    Dim DD As Scripting.Drive
-    Dim B As Boolean
-    Dim Root As String
-    Dim DirSpec As String
-    Dim N As Long
-    Dim M As Long
-    Dim S As String
-    Dim Directories() As String
-        
-    Set FSO = New Scripting.FileSystemObject
-        
-    ' ensure there are no invalid characters in spec.
-    On Error Resume Next
-    err.Clear
-    S = dir(PathSpec, vbNormal)
-    If err.Number <> 0 Then
-        RecursiveMkDir = ErrInvalidCharactersInPath
-        Exit Function
-    End If
-    On Error GoTo 0
-    
-    ' ensure we have an absolute path
-    B = CBool(PathIsRelative(PathSpec))
-    If B = True Then
-        RecursiveMkDir = ErrRelativePath
-        Exit Function
-    End If
-    
-    ' if the directory already exists, get out with success.
-    If FSO.FolderExists(PathSpec) = True Then
-        RecursiveMkDir = ErrSuccess
-        Exit Function
-    End If
-    
-    ' get rid of trailing slash
-    If Right(PathSpec, 1) = "\" Then
-        PathSpec = Left(PathSpec, Len(PathSpec) - 1)
-    End If
-    
-    ' ensure we don't have a filename
-    N = InStrRev(PathSpec, "\")
-    M = InStrRev(PathSpec, ".")
-    If (N > 0) And (M > 0) Then
-        If M > N Then
-            ' period found after last slash
-            RecursiveMkDir = ErrSpecIsFileName
-            Exit Function
-        End If
-    End If
-    
-    If Left(PathSpec, 2) = "\\" Then
-        ' UNC -> \\Server\Share\Folder...
-        N = InStr(3, PathSpec, "\")
-        N = InStr(N + 1, PathSpec, "\")
-        Root = Left(PathSpec, N - 1)
-        DirSpec = Mid(PathSpec, N + 1)
-    Else
-        ' Local or mapped -> C:\Folder....
-        N = InStr(1, PathSpec, ":", vbBinaryCompare)
-        If N = 0 Then
-            RecursiveMkDir = ErrInvalidPathSpecification
-            Exit Function
-        End If
-        Root = Left(PathSpec, N)
-        DirSpec = Mid(PathSpec, N + 2)
-    End If
-    Set DD = FSO.GetDrive(Root)
-    Directories = Split(DirSpec, "\")
-    DirSpec = DD.path
-    For N = LBound(Directories) To UBound(Directories)
-        DirSpec = DirSpec & "\" & Directories(N)
-        If FSO.FolderExists(DirSpec) = False Then
-            On Error Resume Next
-            err.Clear
-            FSO.CreateFolder (DirSpec)
-            If err.Number <> 0 Then
-                RecursiveMkDir = ErrDirectoryCreateError
-                Exit Function
-            End If
-        End If
-    Next N
-    RecursiveMkDir = ErrSuccess
-    End Function
+ 

+ 2 - 3
source/modules/VCS_File.bas

@@ -1,5 +1,4 @@
 Option Compare Database
 Option Compare Database
-
 Option Private Module
 Option Private Module
 Option Explicit
 Option Explicit
 
 
@@ -167,11 +166,11 @@ Public Sub ConvertUtf8Ucs2(ByVal Source As String, ByVal dest As String)
     Dim in_2 As Integer
     Dim in_2 As Integer
     Dim in_3 As Integer
     Dim in_3 As Integer
 
 
+    logger "ConvertUtf8Ucs2", "DEBUG", "Convert Utf8 file " & Source & " to UCS File " & dest
+
     f_in = BinOpen(Source, "r")
     f_in = BinOpen(Source, "r")
     f_out = BinOpen(dest, "w")
     f_out = BinOpen(dest, "w")
 
 
-    Debug.Print Source, dest
-
     Do While Not f_in.at_eof
     Do While Not f_in.at_eof
         in_1 = BinRead(f_in)
         in_1 = BinRead(f_in)
         If (in_1 And &H80) = 0 Then
         If (in_1 And &H80) = 0 Then

+ 166 - 243
source/modules/VCS_IE_Functions.bas

@@ -1,5 +1,4 @@
 Option Compare Database
 Option Compare Database
-
 Option Private Module
 Option Private Module
 Option Explicit
 Option Explicit
 
 
@@ -13,67 +12,122 @@ Public Const TristateTrue = -1, TristateFalse = 0, TristateUseDefault = -2
 ' constants for names conversion
 ' constants for names conversion
 Public Const ForbiddenCars = "34,42,47,58,60,62,63,92,124"
 Public Const ForbiddenCars = "34,42,47,58,60,62,63,92,124"
 
 
+Dim p_source_dir As String
+Public Function source_dir() As String
+    If Len(p_source_dir) = 0 Then
+        ' get the source directory's path
+        p_source_dir = norm_dir_path(CurrentProject.path) & "source\"
+        logger "source_dir", "DEBUG", "> Source's directory defined: " & p_source_dir
+    End If
+    source_dir = p_source_dir
+End Function
 
 
-' Can we export without closing the form?
 
 
-' Export a database object with optional UCS2-to-UTF-8 conversion.
-Public Sub ExportObject(ByVal obj_type_num As Integer, ByVal obj_name As String, _
-                    ByVal file_path As String, Optional ByVal Ucs2Convert As Boolean = False)
+'returns true if named module is NOT part of the VCS / OA code
+Public Function IsNotVCS(ByVal name As String) As Boolean
 
 
-    VCS_Dir.MkDirIfNotExist Left$(file_path, InStrRev(file_path, "\"))
-    
-    If Ucs2Convert Then
-        Dim tempFileName As String
-        tempFileName = VCS_File.TempFile()
-        Application.SaveAsText obj_type_num, obj_name, tempFileName
-        VCS_File.ConvertUcs2Utf8 tempFileName, file_path
-
-        Dim FSO As Object
-        Set FSO = CreateObject("Scripting.FileSystemObject")
-        FSO.DeleteFile tempFileName
+    '*** if OA addin is used from its developement version (OA exporting itself)
+    If CurrentProject.name = "openaccess.accda" Then
+        IsNotVCS = True
+        Exit Function
+    End If
+    '****
+
+    If name <> "OA_Controls" And _
+      name <> "OA_Log" And _
+      name <> "OA_Main" And _
+      name <> "OA_Optimizer" And _
+      name <> "OA_Properties" And _
+      name <> "OA_Shell" And _
+      name <> "OA_Utils" And _
+      name <> "VCS_DataMacro" And _
+      name <> "VCS_Dir" And _
+      name <> "VCS_File" And _
+      name <> "VCS_IE_Functions" And _
+      name <> "VCS_ImportExport" And _
+      name <> "VCS_Reference" And _
+      name <> "VCS_Relation" And _
+      name <> "VCS_Report" And _
+      name <> "VCS_String" And _
+      name <> "VCS_Table" Then
+        IsNotVCS = True
     Else
     Else
-        Application.SaveAsText obj_type_num, obj_name, file_path
+        IsNotVCS = False
     End If
     End If
 
 
-    logger "ExportObject", "DEBUG", "Object of type " & obj_type_num & " named " & obj_name & " exported to " & file_path
-    
-    If obj_type_num <> acModule Then
-        SanitizeFile file_path
-    End If
-    
-End Sub
+End Function
 
 
-' Import a database object with optional UTF-8-to-UCS2 conversion.
-Public Sub ImportObject(ByVal obj_type_num As Integer, ByVal obj_name As String, _
-                    ByVal file_path As String, Optional ByVal Ucs2Convert As Boolean = False)
-    
-    If Not VCS_Dir.FileExists(file_path) Then
-        logger "ImportObject", "ERROR", "Can't find the file " & file_path
-        Exit Sub
-    End If
-    
-    On Error GoTo err
-    
-    If Ucs2Convert Then
-        Dim tempFileName As String
-        tempFileName = VCS_File.TempFile()
-        VCS_File.ConvertUtf8Ucs2 file_path, tempFileName
-        
-        Application.LoadFromText obj_type_num, obj_name, tempFileName
-        
-        Dim FSO As Object
-        Set FSO = CreateObject("Scripting.FileSystemObject")
-        FSO.DeleteFile tempFileName
-    Else
-        Application.LoadFromText obj_type_num, obj_name, file_path
-    End If
-    
-    logger "ImportObject", "DEBUG", "Object of type " & obj_type_num & " named " & obj_name & " imported from " & file_path
 
 
-Exit Sub
-err:
-    logger "ImportObject", "CRITICAL", "Unable to import the object " & obj_name & " (" & obj_type_num & ")" & "[" & err.Description & "]"
-End Sub
+'[DEPRECATED]
+' Export a database object with optional UCS2-to-UTF-8 conversion.
+'Public Sub ExportObject(ByVal obj_type_num As Integer, ByVal obj_name As String, _
+'                    ByVal file_path As String, Optional ByVal Ucs2Convert As Boolean = False)
+'
+'    VCS_Dir.MkDirIfNotExist Left$(file_path, InStrRev(file_path, "\"))
+'
+'    If Ucs2Convert Then
+'        Dim tempFileName As String
+'        tempFileName = VCS_File.TempFile()
+'        Application.SaveAsText obj_type_num, obj_name, tempFileName
+'        VCS_File.ConvertUcs2Utf8 tempFileName, file_path
+'
+'        Dim FSO As Object
+'        Set FSO = CreateObject("Scripting.FileSystemObject")
+'        FSO.DeleteFile tempFileName
+'    Else
+'        Application.SaveAsText obj_type_num, obj_name, file_path
+'    End If
+'
+'    logger "ExportObject", "DEBUG", "Object of type " & obj_type_num & " named " & obj_name & " exported to " & file_path
+'
+'    If obj_type_num <> acModule Then
+'        SanitizeFile file_path
+'    End If
+'
+'End Sub
+
+'[DEPRECATED]
+' Import a database object with optional UTF-8-to-UCS2 conversion.
+'Public Sub ImportObject(ByVal obj_type_num As Integer, ByVal obj_name As String, _
+'                    ByVal file_path As String, Optional ByVal Ucs2Convert As Boolean = False)
+'    Dim tempFileName As String
+'    tempFileName = ""
+'
+'    logger "ImportObject", "DEBUG", "Try to import " & obj_name & "(type " & obj_type_num & ")  from: " & file_path
+'
+'    If Not VCS_Dir.FileExists(file_path) Then
+'        logger "ImportObject", "ERROR", "Can't find the file " & file_path
+'        GoTo end_
+'    End If
+'
+'    On Error GoTo err
+'
+'    If Ucs2Convert Then
+'
+'        tempFileName = VCS_File.TempFile()
+'        VCS_File.ConvertUtf8Ucs2 file_path, tempFileName
+'
+'        logger "ImportObject", "DEBUG", "Load data from " & tempFileName
+'        Application.LoadFromText obj_type_num, obj_name, tempFileName
+'
+'    Else
+'
+'        logger "ImportObject", "DEBUG", "Load data from " & file_path
+'        Application.LoadFromText obj_type_num, obj_name, file_path
+'    End If
+'
+'    logger "ImportObject", "DEBUG", "> imported"
+'
+'end_:
+'    If Len(tempFileName) > 0 Then
+'        DelIfExist tempFileName
+'    End If
+'
+'    Exit Sub
+'err:
+'    logger "ImportObject", "CRITICAL", "Unable to import " & obj_name & "[" & err.Description & "]"
+'    'GoTo end_  ' > on error, don't delete the file (debugging purpose)
+'End Sub
 
 
 Public Sub SanitizeFile(ByVal filepath As String)
 Public Sub SanitizeFile(ByVal filepath As String)
 ' cleans the file from unnecessary lines
 ' cleans the file from unnecessary lines
@@ -204,208 +258,77 @@ Public Sub SanitizeFile(ByVal filepath As String)
 End Sub
 End Sub
 
 
 
 
-' For each *.txt in `Path`, find and remove a number of problematic but
-' unnecessary lines of VB code that are inserted automatically by the
-' Access GUI and change often (we don't want these lines of code in
-' version control).
-Public Sub SanitizeTextFiles(ByVal path As String, ByVal Ext As String)
-
-    Dim FSO As Object
-    Set FSO = CreateObject("Scripting.FileSystemObject")
-    '
-    '  Setup Block matching Regex.
-    Dim rxBlock As Object
-    Set rxBlock = CreateObject("VBScript.RegExp")
-    rxBlock.ignoreCase = False
-    '
-    '  Match PrtDevNames / Mode with or  without W
-    Dim srchPattern As String
-    srchPattern = "PrtDev(?:Names|Mode)[W]?"
-    
-    If (AggressiveSanitize = True) Then
-      '  Add and group aggressive matches
-      srchPattern = "(?:" & srchPattern
-      srchPattern = srchPattern & "|GUID|""GUID""|NameMap|dbLongBinary ""DOL"""
-      srchPattern = srchPattern & ")"
-    End If
-    '  Ensure that this is the begining of a block.
-    srchPattern = srchPattern & " = Begin"
-'Debug.Print srchPattern
-    rxBlock.Pattern = srchPattern
-    '
-    '  Setup Line Matching Regex.
-    Dim rxLine As Object
-    Set rxLine = CreateObject("VBScript.RegExp")
-    srchPattern = "^\s*(?:"
-    srchPattern = srchPattern & "Checksum ="
-    srchPattern = srchPattern & "|BaseInfo|NoSaveCTIWhenDisabled =1"
-    If (StripPublishOption = True) Then
-        srchPattern = srchPattern & "|dbByte ""PublishToWeb"" =""1"""
-        srchPattern = srchPattern & "|PublishOption =1"
-    End If
-    srchPattern = srchPattern & ")"
-'Debug.Print srchPattern
-    rxLine.Pattern = srchPattern
-    Dim filename As String
-    filename = dir$(path & "*." & Ext)
-    If Len(filename) = 0 Then
-        logger "SanitizeTextFiles", "INFO", "> No file to sanitized"
-        Exit Sub
-    End If
-    
-    Dim isReport As Boolean
-    isReport = False
-    
-    Do Until Len(filename) = 0
-        DoEvents
-        Dim obj_name As String
-        obj_name = Mid$(filename, 1, InStrRev(filename, ".") - 1)
-
-        Dim InFile As Object
-        Set InFile = FSO.OpenTextFile(path & obj_name & "." & Ext, iomode:=ForReading, Create:=False, Format:=TristateFalse)
-        Dim OutFile As Object
-        Set OutFile = FSO.CreateTextFile(path & obj_name & ".sanitize", overwrite:=True, unicode:=False)
+' Close all open forms.
+Public Sub CloseFormsReports()
+    On Error GoTo errorHandler
+    logger "CloseFormsReports", "DEBUG", "Close any opened form or report"
     
     
-        Dim getLine As Boolean
-        getLine = True
-        
-        Do Until InFile.AtEndOfStream
-            DoEvents
-            Dim txt As String
-            '
-            ' Check if we need to get a new line of text
-            If getLine = True Then
-                txt = InFile.readline
-            Else
-                getLine = True
-            End If
-            '
-            ' Skip lines starting with line pattern
-            If rxLine.test(txt) Then
-                Dim rxIndent As Object
-                Set rxIndent = CreateObject("VBScript.RegExp")
-                rxIndent.Pattern = "^(\s+)\S"
-                '
-                ' Get indentation level.
-                Dim matches As Object
-                Set matches = rxIndent.Execute(txt)
-                '
-                ' Setup pattern to match current indent
-                Select Case matches.count
-                    Case 0
-                        rxIndent.Pattern = "^" & vbNullString
-                    Case Else
-                        rxIndent.Pattern = "^(\s{0," & Len(matches(0).SubMatches(0)) & "})"
-                End Select
-                rxIndent.Pattern = rxIndent.Pattern + "\S"
-                '
-                ' Skip lines with deeper indentation
-
-                Do Until InFile.AtEndOfStream
-                    txt = InFile.readline
-                    If rxIndent.test(txt) Then Exit Do
-                Loop
-                ' We've moved on at least one line so do get a new one
-                ' when starting the loop again.
-                getLine = False
-            '
-            ' skip blocks of code matching block pattern
-            ElseIf rxBlock.test(txt) Then
-                Do Until InFile.AtEndOfStream
-                    txt = InFile.readline
-                    If InStr(txt, "End") Then Exit Do
-                Loop
-            ElseIf InStr(1, txt, "Begin Report") = 1 Then
-                isReport = True
-                OutFile.WriteLine txt
-            ElseIf isReport = True And (InStr(1, txt, "    Right =") Or InStr(1, txt, "    Bottom =")) Then
-                'skip line
-                If InStr(1, txt, "    Bottom =") Then
-                    isReport = False
-                End If
-            Else
-                OutFile.WriteLine txt
-            End If
-        Loop
-        OutFile.Close
-        InFile.Close
-
-        FSO.DeleteFile (path & filename)
-
-        Dim thisFile As Object
-        Set thisFile = FSO.GetFile(path & obj_name & ".sanitize")
-        thisFile.Move (path & filename)
-        
-        logger "SanitizeTextFiles", "DEBUG", "> File " & path & filename & " sanitized"
-
-        filename = dir$()
+    Dim threshold As Integer
+    threshold = 0
+    Do While Forms.count > threshold
+        If Forms(0).name = "OpenAccess" Then
+            threshold = 1
+        Else
+            DoCmd.Close acForm, Forms(threshold).name
+        End If
+        'DoEvents
     Loop
     Loop
+    Do While Reports.count > 0
+        DoCmd.Close acReport, Reports(0).name
+        'DoEvents
+    Loop
+    
+    DoEvents
+    Exit Sub
 
 
-    logger "SanitizeTextFiles", "INFO", "> Files " & path & "*." & Ext & " sanitized"
-
+errorHandler:
+    logger "CloseFormsReports", "CRITICAL", "Error #" & err.Number & err.Description
 End Sub
 End Sub
 
 
-Public Function to_filename(ByVal object_name As String) As String
-    ' return a file name for the object's name
-    ' 1- access does not accept brackets for object's names
-    ' 2- file's names can not contain those caracters:
-    ' \ [92]
-    ' / [47]
-    ' : [58]
-    ' * [42]
-    ' ? [63]
-    ' " [34]
-    ' < [60]
-    ' > [62]
-    ' | [124]
-    '
-    ' this function replaces caracters which are not allowed for file names by [x],
-    'where x is the ascii code of the character
-    ' test: "test_\_/_:_*_?_""_<_>_|" should become test_[92]_[47]_[58]_[42]_[63]_[34]_[60]_[62]_[124]
-    ' to convert back the string, use to_accessname
-    
-    Dim result As String
-    Dim ascii_code As Variant
+
+'errno 457 - duplicate key (& item)
+Public Function StrSetToCol(ByVal strSet As String, ByVal delimiter As String) As Collection 'throws errors
+    Dim strSetArray() As String
+    Dim col As Collection
     
     
-    result = object_name
+    Set col = New Collection
+    strSetArray = Split(strSet, delimiter)
     
     
-    For Each ascii_code In Split(ForbiddenCars, ",")
-        result = Replace(result, Chr(CInt(ascii_code)), "[" & ascii_code & "]")
+    Dim item As Variant
+    For Each item In strSetArray
+        col.Add item, item
     Next
     Next
+    
+    Set StrSetToCol = col
+End Function
 
 
-    If result <> object_name Then
-        logger "to_filename", "DEBUG", "> Object's name " & object_name & " transformed to " & result
-    End If
 
 
-    to_filename = result
-Exit Function
-err:
-    Call logger("to_filename", "ERROR", "Unable to convert object's name " & object_name & " to file's name")
-    to_filename = object_name
-End Function
+' Check if an item or key is in a collection
+Public Function InCollection(col As Collection, Optional vItem, Optional vKey) As Boolean
+    On Error Resume Next
 
 
-Public Function to_accessname(ByVal file_name As String) As String
-On Error GoTo err
-    ' return an object name from a file's name
-    ' see function 'to_filename' for more informations
-    ' test: "test_[92]_[47]_[58]_[42]_[63]_[34]_[60]_[62]_[124]" should become test_\_/_:_*_?_"_<_>_|
+    Dim vColItem As Variant
 
 
-    Dim result As String
-    Dim ascii_code As Variant
-    
-    result = file_name
-    
-    For Each ascii_code In Split(ForbiddenCars, ",")
-        result = Replace(result, "[" & ascii_code & "]", Chr(CInt(ascii_code)))
-    Next
+    InCollection = False
 
 
-    If result <> file_name Then
-        logger "to_accessname", "DEBUG", "> File's name " & file_name & " transformed to " & result
+    If Not IsMissing(vKey) Then
+        col.item vKey
+
+        '5 if not in collection, it is 91 if no collection exists
+        If err.Number <> 5 And err.Number <> 91 Then
+            InCollection = True
+        End If
+    ElseIf Not IsMissing(vItem) Then
+        For Each vColItem In col
+            If vColItem = vItem Then
+                InCollection = True
+                GoTo Exit_Proc
+            End If
+        Next vColItem
     End If
     End If
 
 
-    to_accessname = result
-Exit Function
-err:
-    Call logger("to_accessname", "ERROR", "Unable to convert file's name " & file_name & " to access object's name")
-    to_accessname = file_name
+Exit_Proc:
+    Exit Function
+Err_Handle:
+    Resume Exit_Proc
 End Function
 End Function

+ 0 - 687
source/modules/VCS_ImportExport.bas

@@ -1,687 +0,0 @@
-Option Compare Database
-Option Explicit
-
-' List of lookup tables that are part of the program rather than the
-' data, to be exported with source code
-' Set to "*" to export the contents of all tables
-'Only used in ExportAllSource
-'Private Const include_tables As String = ""
-Private include_tables As String
-
-' This is used in ImportAllSource
-Private Const DebugOutput As Boolean = False
-'this is used in ExportAllSource
-'Causes the VCS_ and OA_ modules to be exported
-Private Const ArchiveMyself As Boolean = False
-
-
-'returns true if named module is NOT part of the VCS / OA code
-Private Function IsNotVCS(ByVal name As String) As Boolean
-
-    '*** if OA addin is used from its developement version (OA exporting itself)
-    If CurrentProject.name = "openaccess.accda" Then
-        IsNotVCS = True
-        Exit Function
-    End If
-    '****
-
-    If name <> "OA_Controls" And _
-      name <> "OA_Log" And _
-      name <> "OA_Main" And _
-      name <> "OA_Optimizer" And _
-      name <> "OA_Properties" And _
-      name <> "OA_Shell" And _
-      name <> "OA_Utils" And _
-      name <> "VCS_DataMacro" And _
-      name <> "VCS_Dir" And _
-      name <> "VCS_File" And _
-      name <> "VCS_IE_Functions" And _
-      name <> "VCS_ImportExport" And _
-      name <> "VCS_Reference" And _
-      name <> "VCS_Relation" And _
-      name <> "VCS_Report" And _
-      name <> "VCS_String" And _
-      name <> "VCS_Table" Then
-        IsNotVCS = True
-    Else
-        IsNotVCS = False
-    End If
-
-End Function
-
-' Main entry point for EXPORT. Export all forms, reports, queries,
-' macros, modules, and lookup tables to `source` folder under the
-' database's folder.
-Public Sub ExportAllSource()
-    Dim db As Object ' DAO.Database
-    Dim source_path As String
-    Dim obj_path As String
-    Dim qry As Object ' DAO.QueryDef
-    Dim doc As Object ' DAO.Document
-    Dim obj_type As Variant
-    Dim obj_type_split() As String
-    Dim obj_type_label As String
-    Dim obj_type_name As String
-    Dim obj_type_num As Integer
-    Dim obj_count As Integer
-    Dim obj_data_count As Integer
-    Dim ucs2 As Boolean
-    Dim full_path As String
-
-    logger "ExportAllSource", "INFO", "Begin 'Export all sources'"
-
-    include_tables = get_include_tables()
-    
-    logger "ExportAllSource", "DEBUG", "Include_tables: " & include_tables
-    logger "ExportAllSource", "DEBUG", "Optimizer on: " & optimizer_activated()
-    
-    logger "ExportAllSource", "DEBUG", "Save project"
-    
-    SaveProject
-    
-    Set db = CurrentDb
-
-    CloseFormsReports
-    'InitUsingUcs2
-
-    source_path = VCS_Dir.ProjectPath() & "source\"
-    logger "ExportAllSource", "DEBUG", "source_path: " & source_path
-
-    VCS_Dir.MkDirIfNotExist source_path
-
-    Call ExportProperties(CurrentDb, source_path & "database.properties")
-    
-    obj_path = source_path & "queries\"
-    VCS_Dir.ClearTextFilesFromDir obj_path, "bas"
-    
-    logger "ExportAllSource", "INFO", "Exporting queries..."
-    
-    obj_count = 0
-    For Each qry In db.QueryDefs
-    
-        '### 11/10/2016: add optimizer
-        If optimizer_activated() Then
-            If Not needs_export(acQuery, qry.name) > 0 Then
-                logger "ExportProperties", "DEBUG", "Query " & qry.name & " skipped"
-                obj_count = obj_count + 1
-                GoTo next_qry
-            End If
-        End If
-        '###
-        
-        DoEvents
-        If Left$(qry.name, 1) <> "~" Then
-            full_path = obj_path & VCS_IE_Functions.to_filename(qry.name) & ".bas"
-            VCS_IE_Functions.ExportObject acQuery, qry.name, full_path, VCS_File.UsingUcs2
-            obj_count = obj_count + 1
-        End If
-        
-next_qry:
-        Call SysCmd(4, "Export query: " & obj_count & " on " & db.QueryDefs.count)
-    Next
-    logger "ExportAllSource", "INFO", "> " & obj_count & " queries exported"
-    
-        
-    For Each obj_type In Split( _
-        "forms|Forms|" & acForm & "," & _
-        "reports|Reports|" & acReport & "," & _
-        "macros|Scripts|" & acMacro & "," & _
-        "modules|Modules|" & acModule _
-        , "," _
-    )
-        obj_type_split = Split(obj_type, "|")
-        obj_type_label = obj_type_split(0)
-        obj_type_name = obj_type_split(1)
-        obj_type_num = val(obj_type_split(2))
-        obj_path = source_path & obj_type_label & "\"
-        obj_count = 0
-        
-        'a retirer
-        VCS_Dir.ClearTextFilesFromDir obj_path, "bas"
-        
-        logger "ExportAllSource", "INFO", "Exporting " & obj_type_label & "..."
-        
-        For Each doc In db.Containers(obj_type_name).Documents
-        
-            '### 11/10/2016: add optimizer
-            If optimizer_activated() Then
-                If Not needs_export(obj_type_num, doc.name) > 0 Then
-                    obj_count = obj_count + 1
-                    Call SysCmd(4, "Exporting " & obj_type_label & ": " & obj_count & " on " & db.Containers(obj_type_name).Documents.count)
-                    logger "ExportAllSource", "DEBUG", obj_type_label & " '" & doc.name & " skipped"
-                    GoTo next_doc
-                End If
-            End If
-            '###
-        
-            DoEvents
-            
-            If (Left$(doc.name, 1) <> "~") And _
-               (IsNotVCS(doc.name) Or ArchiveMyself) Then
-                
-                If obj_type_label = "modules" Then
-                    ucs2 = False
-                Else
-                    ucs2 = VCS_File.UsingUcs2
-                End If
-                
-                full_path = obj_path & VCS_IE_Functions.to_filename(doc.name) & ".bas"
-                VCS_IE_Functions.ExportObject obj_type_num, doc.name, full_path, ucs2
-                
-                If obj_type_label = "reports" Then
-                    full_path = obj_path & VCS_IE_Functions.to_filename(doc.name) & ".pv"
-                    VCS_Report.ExportPrintVars doc.name, obj_path & doc.name & ".pv"
-                End If
-                
-                Call SysCmd(4, "Exporting " & obj_type_label & ": " & obj_count & " on " & db.Containers(obj_type_name).Documents.count)
-
-                obj_count = obj_count + 1
-            End If
-                        
-next_doc:
-        Next
-        
-        logger "ExportAllSource", "INFO", "> " & obj_count & " " & obj_type_label & " exported"
-        
-    Next
-    
-    Call SysCmd(4, "Exporting references")
-    VCS_Reference.ExportReferences source_path
-
-'-------------------------table export------------------------
-
-    Call SysCmd(4, "Exporting tables")
-    obj_path = source_path & "tables\"
-    VCS_Dir.MkDirIfNotExist Left$(obj_path, InStrRev(obj_path, "\"))
-    VCS_Dir.ClearTextFilesFromDir obj_path, "txt", True
-    
-    Dim td As DAO.TableDef
-    Dim tds As DAO.TableDefs
-    Set tds = db.TableDefs
-
-    obj_type_label = "tbldef"
-    obj_type_name = "Table_Def"
-    obj_type_num = acTable
-    obj_path = source_path & obj_type_label & "\"
-    obj_count = 0
-    obj_data_count = 0
-    VCS_Dir.MkDirIfNotExist Left$(obj_path, InStrRev(obj_path, "\"))
-    
-    'move these into Table and DataMacro modules?
-    ' - We don't want to determin file extentions here - or obj_path either!
-    VCS_Dir.ClearTextFilesFromDir obj_path, "sql"
-    VCS_Dir.ClearTextFilesFromDir obj_path, "xml"
-    VCS_Dir.ClearTextFilesFromDir obj_path, "LNKD"
-    
-    Dim IncludeTablesCol As Collection
-    Set IncludeTablesCol = StrSetToCol(include_tables, ",")
-    
-    logger "ExportAllSource", "INFO", "Exporting " & obj_type_label & "..."
-    
-    Dim update_this_tabledef As Boolean
-    
-    For Each td In tds
-    
-        '### 11/10/2016: add optimizer
-        'only update the table definition if this is a complete export
-        'or if the table definition has been modified since last export
-        update_this_tabledef = (Not optimizer_activated() Or needs_export(acTable, td.name) > 0)
-        '###
-
-        ' This is not a system table
-        ' this is not a temporary table
-        If Left$(td.name, 4) <> "MSys" And _
-        Left$(td.name, 1) <> "~" Then
-            
-            If Len(td.connect) = 0 Then ' this is not an external table
-                
-                If update_this_tabledef Then
-                    VCS_Table.ExportTableDef db, td, obj_path
-                Else
-                    logger "ExportAllSource", "DEBUG", "TableDef " & td.name & " skipped"
-                End If
-                
-                If include_tables = "*" Then
-                    DoEvents
-                    VCS_Table.ExportTableData CStr(td.name), source_path & "tables\"
-                    If Len(dir$(source_path & "tables\" & td.name & ".txt")) > 0 Then
-                        obj_data_count = obj_data_count + 1
-                    End If
-                ElseIf (Len(Replace(include_tables, " ", vbNullString)) > 0) And include_tables <> "*" Then
-                    DoEvents
-                    On Error GoTo Err_TableNotFound
-                    If InCollection(IncludeTablesCol, td.name) Then
-                        VCS_Table.ExportTableData CStr(td.name), source_path & "tables\"
-                        obj_data_count = obj_data_count + 1
-                    End If
-Err_TableNotFound:
-                    
-                'else don't export table data
-                End If
-            Else
-                If update_this_tabledef Then
-                    VCS_Table.ExportLinkedTable td.name, obj_path
-                Else
-                    logger "ExportAllSource", "DEBUG", "TableDef " & td.name & " skipped"
-                End If
-            End If
-            
-            obj_count = obj_count + 1
-            
-            Call SysCmd(4, "Export table definition: " & obj_count & " on " & tds.count)
-            
-        End If
-        
-next_td:
-    Next
-    logger "ExportAllSource", "INFO", "> " & obj_count & " tbldef exported"
-    logger "ExportAllSource", "INFO", "> " & obj_data_count & " table's datas exported"
-    
-    logger "ExportAllSource", "INFO", "Export relations"
-    
-    obj_count = 0
-    obj_path = source_path & "relations\"
-    VCS_Dir.MkDirIfNotExist Left$(obj_path, InStrRev(obj_path, "\"))
-
-    VCS_Dir.ClearTextFilesFromDir obj_path, "txt", True
-
-    Dim aRelation As DAO.Relation
-    
-    Call SysCmd(4, "Exporting relations")
-    For Each aRelation In CurrentDb.Relations
-        ' Exclude relations from system tables and inherited (linked) relations
-        If Not (aRelation.name = "MSysNavPaneGroupsMSysNavPaneGroupToObjects" _
-                Or aRelation.name = "MSysNavPaneGroupCategoriesMSysNavPaneGroups" _
-                Or (aRelation.Attributes And DAO.RelationAttributeEnum.dbRelationInherited) = _
-                DAO.RelationAttributeEnum.dbRelationInherited) Then
-                
-            VCS_Relation.ExportRelation aRelation, obj_path & to_filename(aRelation.name) & ".txt"
-            
-            obj_count = obj_count + 1
-        End If
-    Next
-    
-    logger "ExportAllSource", "INFO", "> " & obj_count & " relations exported"
-
-    
-    logger "ExportAllSource", "INFO", "Export done"
-End Sub
-
-
-' Main entry point for IMPORT. Import all forms, reports, queries,
-' macros, modules, and lookup tables from `source` folder under the
-' database's folder.
-Public Sub ImportAllSource()
-    Dim FSO As Object
-    Dim source_path As String
-    Dim obj_path As String
-    Dim obj_type As Variant
-    Dim obj_type_split() As String
-    Dim obj_type_label As String
-    Dim obj_type_num As Integer
-    Dim obj_count As Integer
-    Dim filename As String
-    Dim obj_name As String
-    Dim ucs2 As Boolean
-
-    logger "ImportAllSource", "INFO", "Begin 'Import all sources'"
-    logger "ImportAllSource", "DEBUG", "Optimizer on: " & optimizer_activated()
-    
-    Set FSO = CreateObject("Scripting.FileSystemObject")
-
-    CloseFormsReports
-    'InitUsingUcs2
-
-    source_path = VCS_Dir.ProjectPath() & "source\"
-    If Not FSO.FolderExists(source_path) Then
-        logger "ImportAllSource", "CRITICAL", "No source found at:" & source_path
-    End If
-
-    Call ImportProperties(CurrentDb, source_path & "database.properties")
-    
-    If Not VCS_Reference.ImportReferences(source_path) Then
-        logger "ImportAllSource", "INFO", "Info: no references file in " & source_path
-    End If
-
-    obj_path = source_path & "queries\"
-    filename = dir$(obj_path & "*.bas")
-    
-    Dim tempFilePath As String
-    tempFilePath = VCS_File.TempFile()
-    
-    If Len(filename) > 0 Then
-        logger "ImportAllSource", "INFO", "Importing queries..."
-        obj_count = 0
-        Do Until Len(filename) = 0
-            DoEvents
-            obj_name = Mid$(filename, 1, InStrRev(filename, ".") - 1)
-            obj_name = VCS_IE_Functions.to_accessname(obj_name)
-            VCS_IE_Functions.ImportObject acQuery, obj_name, obj_path & filename, VCS_File.UsingUcs2
-            VCS_IE_Functions.ExportObject acQuery, obj_name, tempFilePath, VCS_File.UsingUcs2
-            VCS_IE_Functions.ImportObject acQuery, obj_name, tempFilePath, VCS_File.UsingUcs2
-            obj_count = obj_count + 1
-            filename = dir$()
-        Loop
-        logger "ImportAllSource", "INFO", "> " & obj_count & " queries imported"
-    End If
-    
-    VCS_Dir.DelIfExist tempFilePath
-
-    ' restore table definitions
-    obj_path = source_path & "tbldef\"
-    filename = dir$(obj_path & "*.sql")
-    If Len(filename) > 0 Then
-        logger "ImportAllSource", "INFO", "Importing TblDefs..."
-        obj_count = 0
-        Do Until Len(filename) = 0
-            obj_name = Mid$(filename, 1, InStrRev(filename, ".") - 1)
-            obj_name = VCS_IE_Functions.to_accessname(obj_name)
-            VCS_Table.ImportTableDef CStr(obj_name), obj_path
-            obj_count = obj_count + 1
-            filename = dir$()
-        Loop
-        logger "ImportAllSource", "INFO", "> " & obj_count & " TblDefs imported"
-    End If
-    
-    ' restore linked tables - we must have access to the remote store to import these!
-    filename = dir$(obj_path & "*.LNKD")
-    If Len(filename) > 0 Then
-        logger "ImportAllSource", "INFO", "Importing Linked TblDefs..."
-        obj_count = 0
-        Do Until Len(filename) = 0
-            obj_name = Mid$(filename, 1, InStrRev(filename, ".") - 1)
-            obj_name = VCS_IE_Functions.to_accessname(obj_name)
-            VCS_Table.ImportLinkedTable CStr(obj_name), obj_path
-            obj_count = obj_count + 1
-            filename = dir$()
-        Loop
-        logger "ImportAllSource", "INFO", "> " & obj_count & " Linked TblDefs imported"
-    End If
-    
-    ' NOW we may load data
-    obj_path = source_path & "tables\"
-    filename = dir$(obj_path & "*.txt")
-    If Len(filename) > 0 Then
-        logger "ImportAllSource", "INFO", "Importing table's data..."
-        obj_count = 0
-        Do Until Len(filename) = 0
-            DoEvents
-            obj_name = Mid$(filename, 1, InStrRev(filename, ".") - 1)
-            obj_name = VCS_IE_Functions.to_accessname(obj_name)
-            VCS_Table.ImportTableData CStr(obj_name), obj_path
-            obj_count = obj_count + 1
-            filename = dir$()
-        Loop
-        logger "ImportAllSource", "INFO", "> " & obj_count & " table's data imported"
-    End If
-    
-    'load Data Macros - not DRY!
-    obj_path = source_path & "tbldef\"
-    filename = dir$(obj_path & "*.xml")
-    If Len(filename) > 0 Then
-        logger "ImportAllSource", "INFO", "Importing Data Macros..."
-        obj_count = 0
-        Do Until Len(filename) = 0
-            DoEvents
-            obj_name = Mid$(filename, 1, InStrRev(filename, ".") - 1)
-            obj_name = VCS_IE_Functions.to_accessname(obj_name)
-            'VCS_Table.ImportTableData CStr(obj_name), obj_path
-            VCS_DataMacro.ImportDataMacros obj_name, obj_path
-            obj_count = obj_count + 1
-            filename = dir$()
-        Loop
-        logger "ImportAllSource", "INFO", "> " & obj_count & " DataMacros imported"
-    End If
-
-    For Each obj_type In Split( _
-        "forms|" & acForm & "," & _
-        "reports|" & acReport & "," & _
-        "macros|" & acMacro & "," & _
-        "modules|" & acModule _
-        , "," _
-    )
-        obj_type_split = Split(obj_type, "|")
-        obj_type_label = obj_type_split(0)
-        obj_type_num = val(obj_type_split(1))
-        obj_path = source_path & obj_type_label & "\"
-         
-            
-        filename = dir$(obj_path & "*.bas")
-        If Len(filename) > 0 Then
-            logger "ImportAllSource", "INFO", "Importing " & obj_type_label & "..."
-            obj_count = 0
-            Do Until Len(filename) = 0
-                ' DoEvents no good idea!
-                obj_name = Mid$(filename, 1, InStrRev(filename, ".") - 1)
-                obj_name = VCS_IE_Functions.to_accessname(obj_name)
-                If obj_type_label = "modules" Then
-                    ucs2 = False
-                Else
-                    ucs2 = VCS_File.UsingUcs2
-                End If
-                If IsNotVCS(obj_name) Then
-                    VCS_IE_Functions.ImportObject obj_type_num, obj_name, obj_path & filename, ucs2
-                    obj_count = obj_count + 1
-                Else
-                    If ArchiveMyself Then
-                        logger "ImportAllSource", "WARNING", "Module " & obj_name & " could not be updated while running. Ensure latest version is included!"
-                    End If
-                End If
-                filename = dir$()
-            Loop
-            logger "ImportAllSource", "INFO", "> " & obj_count & " " & obj_type_label & " imported"
-        
-        End If
-    
-    Next
-    
-    'import Print Variables
-    logger "ImportAllSource", "INFO", "Importing Print Vars..."
-    obj_count = 0
-    
-    obj_path = source_path & "reports\"
-    filename = dir$(obj_path & "*.pv")
-    Do Until Len(filename) = 0
-        DoEvents
-        obj_name = Mid$(filename, 1, InStrRev(filename, ".") - 1)
-        obj_name = VCS_IE_Functions.to_accessname(obj_name)
-        VCS_Report.ImportPrintVars obj_name, obj_path & filename
-        obj_count = obj_count + 1
-        filename = dir$()
-    Loop
-    logger "ImportAllSource", "INFO", "> " & obj_count & " Print Vars imported"
-    
-    'import relations
-    logger "ImportAllSource", "INFO", "Importing Relations..."
-    obj_count = 0
-    obj_path = source_path & "relations\"
-    filename = dir$(obj_path & "*.txt")
-    Do Until Len(filename) = 0
-        DoEvents
-        VCS_Relation.ImportRelation obj_path & filename
-        obj_count = obj_count + 1
-        filename = dir$()
-    Loop
-    logger "ImportAllSource", "INFO", "> " & obj_count & " Relations imported"
-    DoEvents
-    
-    logger "ImportAllSource", "INFO", "Import Done"
-End Sub
-
-' Main entry point for ImportProject.
-' Drop all forms, reports, queries, macros, modules.
-' execute ImportAllSource.
-Public Sub ImportProject()
-On Error GoTo errorHandler
-
-    If OA_MsgBox("This action will delete all existing: " & vbCrLf & _
-              vbCrLf & _
-              Chr$(149) & " Tables" & vbCrLf & _
-              Chr$(149) & " Forms" & vbCrLf & _
-              Chr$(149) & " Macros" & vbCrLf & _
-              Chr$(149) & " Modules" & vbCrLf & _
-              Chr$(149) & " Queries" & vbCrLf & _
-              Chr$(149) & " Reports" & vbCrLf & _
-              vbCrLf & _
-              "Are you sure you want to proceed?", vbCritical + vbYesNo, _
-              "Import Project") <> vbYes Then
-        Exit Sub
-    End If
-
-    Dim db As DAO.Database
-    Set db = CurrentDb
-    CloseFormsReports
-
-    Debug.Print
-    Debug.Print "Deleting Existing Objects"
-    Debug.Print
-    
-    Dim rel As DAO.Relation
-    For Each rel In CurrentDb.Relations
-        If Not (rel.name = "MSysNavPaneGroupsMSysNavPaneGroupToObjects" Or _
-                rel.name = "MSysNavPaneGroupCategoriesMSysNavPaneGroups") Then
-            CurrentDb.Relations.Delete (rel.name)
-        End If
-    Next
-
-    Dim dbObject As Object
-    For Each dbObject In db.QueryDefs
-        DoEvents
-        If Left$(dbObject.name, 1) <> "~" Then
-'            Debug.Print dbObject.Name
-            db.QueryDefs.Delete dbObject.name
-        End If
-    Next
-    
-    Dim td As DAO.TableDef
-    For Each td In CurrentDb.TableDefs
-        If Left$(td.name, 4) <> "MSys" And _
-            Left$(td.name, 1) <> "~" Then
-            CurrentDb.TableDefs.Delete (td.name)
-        End If
-    Next
-
-    Dim objType As Variant
-    Dim objTypeArray() As String
-    Dim doc As Object
-    '
-    '  Object Type Constants
-    Const OTNAME As Byte = 0
-    Const OTID As Byte = 1
-
-    For Each objType In Split( _
-            "Forms|" & acForm & "," & _
-            "Reports|" & acReport & "," & _
-            "Scripts|" & acMacro & "," & _
-            "Modules|" & acModule _
-            , "," _
-        )
-        objTypeArray = Split(objType, "|")
-        DoEvents
-        For Each doc In db.Containers(objTypeArray(OTNAME)).Documents
-            DoEvents
-            If (Left$(doc.name, 1) <> "~") And _
-               (IsNotVCS(doc.name)) Then
-'                Debug.Print doc.Name
-                DoCmd.DeleteObject objTypeArray(OTID), doc.name
-            End If
-        Next
-    Next
-    
-    Debug.Print "================="
-    Debug.Print "Importing Project"
-    ImportAllSource
-    
-    Exit Sub
-
-errorHandler:
-    Debug.Print "VCS_ImportExport.ImportProject: Error #" & err.Number & vbCrLf & _
-                err.Description
-End Sub
-
-' Expose for use as function, can be called by query
-Public Sub make()
-    ImportProject
-End Sub
-
-
-
-'===================================================================================================================================
-'-----------------------------------------------------------'
-' Helper Functions - these should be put in their own files '
-'-----------------------------------------------------------'
-
-' Close all open forms.
-Private Sub CloseFormsReports()
-    On Error GoTo errorHandler
-    logger "CloseFormsReports", "DEBUG", "Close any opened form or report"
-    
-    Dim threshold As Integer
-    threshold = 0
-    Do While Forms.count > threshold
-        If Forms(0).name = "OpenAccess" Then
-            threshold = 1
-        Else
-            DoCmd.Close acForm, Forms(threshold).name
-        End If
-        'DoEvents
-    Loop
-    Do While Reports.count > 0
-        DoCmd.Close acReport, Reports(0).name
-        'DoEvents
-    Loop
-    
-    DoEvents
-    Exit Sub
-
-errorHandler:
-    logger "CloseFormsReports", "CRITICAL", "Error #" & err.Number & err.Description
-End Sub
-
-
-'errno 457 - duplicate key (& item)
-Public Function StrSetToCol(ByVal strSet As String, ByVal delimiter As String) As Collection 'throws errors
-    Dim strSetArray() As String
-    Dim col As Collection
-    
-    Set col = New Collection
-    strSetArray = Split(strSet, delimiter)
-    
-    Dim item As Variant
-    For Each item In strSetArray
-        col.Add item, item
-    Next
-    
-    Set StrSetToCol = col
-End Function
-
-
-' Check if an item or key is in a collection
-Public Function InCollection(col As Collection, Optional vItem, Optional vKey) As Boolean
-    On Error Resume Next
-
-    Dim vColItem As Variant
-
-    InCollection = False
-
-    If Not IsMissing(vKey) Then
-        col.item vKey
-
-        '5 if not in collection, it is 91 if no collection exists
-        If err.Number <> 5 And err.Number <> 91 Then
-            InCollection = True
-        End If
-    ElseIf Not IsMissing(vItem) Then
-        For Each vColItem In col
-            If vColItem = vItem Then
-                InCollection = True
-                GoTo Exit_Proc
-            End If
-        Next vColItem
-    End If
-
-Exit_Proc:
-    Exit Function
-Err_Handle:
-    Resume Exit_Proc
-End Function

+ 36 - 14
source/modules/VCS_Reference.bas

@@ -9,8 +9,17 @@ Public Sub set_ignoreref(str)
 End Sub
 End Sub
 
 
 
 
-' Import References from a CSV, true=SUCCESS
-Public Function ImportReferences(ByVal obj_path As String) As Boolean
+' Import References from a CSV
+Public Function ImportReferences() As Boolean
+
+    Dim file_path As String
+    Dim count, total As Integer
+    
+    file_path = joinpaths(source_dir(), "references.csv")
+    
+    logger "ImportReferences", "INFO", "Import References"
+    logger "ImportReferences", "DEBUG", "> import from: " & file_path
+    
     Dim FSO As Object
     Dim FSO As Object
     Dim InFile As Object
     Dim InFile As Object
     Dim Line As String
     Dim Line As String
@@ -20,17 +29,18 @@ Public Function ImportReferences(ByVal obj_path As String) As Boolean
     Dim Minor As Long
     Dim Minor As Long
     Dim filename As String
     Dim filename As String
     Dim refName As String
     Dim refName As String
-    Dim count As Integer
-    count = 0
-    filename = dir$(obj_path & "references.csv")
+    
+    filename = dir$(file_path)
+    
     If Len(filename) = 0 Then
     If Len(filename) = 0 Then
-        ImportReferences = False
-        Exit Function
+        logger "ImportReferences", "INFO", "> No references to import"
     End If
     End If
+    
     Set FSO = CreateObject("Scripting.FileSystemObject")
     Set FSO = CreateObject("Scripting.FileSystemObject")
-    Set InFile = FSO.OpenTextFile(obj_path & filename, iomode:=ForReading, Create:=False, Format:=TristateFalse)
+    Set InFile = FSO.OpenTextFile(file_path, iomode:=ForReading, Create:=False, Format:=TristateFalse)
+    
+    On Error GoTo failed_guid
     
     
-On Error GoTo failed_guid
     Do Until InFile.AtEndOfStream
     Do Until InFile.AtEndOfStream
         Line = InFile.readline
         Line = InFile.readline
         item = Split(Line, ",")
         item = Split(Line, ",")
@@ -48,12 +58,15 @@ On Error GoTo failed_guid
         End If
         End If
 go_on:
 go_on:
     Loop
     Loop
-On Error GoTo 0
+    
+    On Error GoTo 0
+
     InFile.Close
     InFile.Close
     Set InFile = Nothing
     Set InFile = Nothing
     Set FSO = Nothing
     Set FSO = Nothing
+    
     logger "ImportReferences", "INFO", count & " imported from " & filename
     logger "ImportReferences", "INFO", count & " imported from " & filename
-    ImportReferences = True
+    
     Exit Function
     Exit Function
     
     
 failed_guid:
 failed_guid:
@@ -68,7 +81,8 @@ failed_guid:
 End Function
 End Function
 
 
 ' Export References to a CSV
 ' Export References to a CSV
-Public Sub ExportReferences(ByVal obj_path As String)
+Public Sub ExportReferences()
+    Dim filepath As String
     Dim FSO As Object
     Dim FSO As Object
     Dim OutFile As Object
     Dim OutFile As Object
     Dim Line As String
     Dim Line As String
@@ -77,8 +91,15 @@ Public Sub ExportReferences(ByVal obj_path As String)
     Dim item As Variant
     Dim item As Variant
     count = 0
     count = 0
     
     
+    logger "ExportReferences", "INFO", "Export references"
+    
+    filepath = joinpaths(source_dir(), "references.csv")
+    
+    logger "ExportReferences", "DEBUG", "> export to: " & filepath
+    
     Set FSO = CreateObject("Scripting.FileSystemObject")
     Set FSO = CreateObject("Scripting.FileSystemObject")
-    Set OutFile = FSO.CreateTextFile(obj_path & "references.csv", overwrite:=True, unicode:=False)
+    Set OutFile = FSO.CreateTextFile(filepath, overwrite:=True, unicode:=False)
+    
     For Each ref In Application.References
     For Each ref In Application.References
         
         
         For Each item In Split(ignoreref, ",")
         For Each item In Split(ignoreref, ",")
@@ -100,7 +121,8 @@ Public Sub ExportReferences(ByVal obj_path As String)
         End If
         End If
 go_on:
 go_on:
     Next
     Next
+    
     OutFile.Close
     OutFile.Close
     
     
-    logger "ExportReferences", "INFO", count & " references exported to" & obj_path & "references.csv"
+    logger "ExportReferences", "INFO", count & " references exported"
 End Sub
 End Sub

+ 7 - 10
source/modules/VCS_Table.bas

@@ -21,7 +21,7 @@ End Type
 Private k() As structEnforce
 Private k() As structEnforce
 
 
 
 
-Public Sub ExportLinkedTable(ByVal tbl_name As String, ByVal obj_path As String)
+Public Sub ExportLinkedTable(ByVal tbl_name As String, ByVal dirpath As String)
     On Error GoTo Err_LinkedTable
     On Error GoTo Err_LinkedTable
     
     
     Dim tempFilePath As String
     Dim tempFilePath As String
@@ -33,8 +33,7 @@ Public Sub ExportLinkedTable(ByVal tbl_name As String, ByVal obj_path As String)
 
 
     Set FSO = CreateObject("Scripting.FileSystemObject")
     Set FSO = CreateObject("Scripting.FileSystemObject")
     ' open file for writing with Create=True, Unicode=True (USC-2 Little Endian format)
     ' open file for writing with Create=True, Unicode=True (USC-2 Little Endian format)
-    VCS_Dir.MkDirIfNotExist obj_path
-    
+
     Set OutFile = FSO.CreateTextFile(tempFilePath, overwrite:=True, unicode:=True)
     Set OutFile = FSO.CreateTextFile(tempFilePath, overwrite:=True, unicode:=True)
     
     
     OutFile.Write CurrentDb.TableDefs(tbl_name).name
     OutFile.Write CurrentDb.TableDefs(tbl_name).name
@@ -72,7 +71,7 @@ Err_LinkedTable_Fin:
     OutFile.Close
     OutFile.Close
     'save files as .odbc
     'save files as .odbc
     Dim path As String
     Dim path As String
-    path = obj_path & VCS_IE_Functions.to_filename(tbl_name) & ".LNKD"
+    path = dirpath & to_filename(tbl_name) & ".LNKD"
     VCS_File.ConvertUcs2Utf8 tempFilePath, path
     VCS_File.ConvertUcs2Utf8 tempFilePath, path
     
     
     logger "ExportLinkedTable", "DEBUG", "LinkedTable " & tbl_name & " exported to " & path
     logger "ExportLinkedTable", "DEBUG", "LinkedTable " & tbl_name & " exported to " & path
@@ -81,8 +80,7 @@ Err_LinkedTable_Fin:
     
     
 Err_LinkedTable:
 Err_LinkedTable:
     OutFile.Close
     OutFile.Close
-    logger "ImportLinkedTable", "CRITICAL", "ERROR: IMPORT LINKED TABLE: " & err.Description
-    Call err.Raise(60000, "Critical error", "Critical error occured, see the log file for more informations")
+    logger "ExportLinkedTable", "ERROR", "Unable to export " & tbl_name & ": " & err.Description
     Resume Err_LinkedTable_Fin
     Resume Err_LinkedTable_Fin
 End Sub
 End Sub
 
 
@@ -439,7 +437,7 @@ next_field:
     OutFile.Close
     OutFile.Close
     
     
     Dim path As String
     Dim path As String
-    path = obj_path & VCS_IE_Functions.to_filename(tbl_name) & ".txt"
+    path = obj_path & to_filename(tbl_name) & ".txt"
     VCS_File.ConvertUcs2Utf8 tempFileName, path
     VCS_File.ConvertUcs2Utf8 tempFileName, path
     logger "ExportTableData", "DEBUG", "Data from '" & tbl_name & "' exported to " & path
     logger "ExportTableData", "DEBUG", "Data from '" & tbl_name & "' exported to " & path
     FSO.DeleteFile tempFileName
     FSO.DeleteFile tempFileName
@@ -462,7 +460,7 @@ Private Sub KillTable(ByVal tblName As String, db As Object)
     End If
     End If
 End Sub
 End Sub
 
 
-Public Sub ImportLinkedTable(ByVal tblName As String, ByRef obj_path As String)
+Public Sub ImportLinkedTable(ByVal tblName As String, ByVal obj_path As String)
     Dim db As DAO.Database
     Dim db As DAO.Database
     Dim FSO As Object
     Dim FSO As Object
     Dim InFile As Object
     Dim InFile As Object
@@ -506,8 +504,7 @@ err_notable_fin:
     GoTo Err_CreateLinkedTable_Fin
     GoTo Err_CreateLinkedTable_Fin
     
     
 Err_CreateLinkedTable:
 Err_CreateLinkedTable:
-    logger "ImportLinkedTable", "CRITICAL", "ERROR: IMPORT LINKED TABLE: " & err.Description
-    Call err.Raise(60000, "Critical error", "Critical error occured, see the log file for more informations")
+    logger "ImportLinkedTable", "ERROR", "Unable to import " & tblName & ": " & err.Description
     Resume Err_CreateLinkedTable_Fin
     Resume Err_CreateLinkedTable_Fin
     
     
 Err_CreateLinkedTable_Fin:
 Err_CreateLinkedTable_Fin:

+ 1 - 1
source/tables/USysOpenAccess.txt

@@ -1,3 +1,3 @@
 key	val
 key	val
 include_tables	USysOpenAccess,USysRegInfo
 include_tables	USysOpenAccess,USysRegInfo
-sources_date	28/11/2016 14:57:48
+sources_date	06/12/2016 14:30:17

+ 0 - 0
tests/reference/source/tbldef/USysOpenAccess.sql → source/tbldefs/USysOpenAccess.sql


+ 6 - 0
source/tbldefs/USysRegInfo.sql

@@ -0,0 +1,6 @@
+CREATE TABLE [USysRegInfo] (
+  [Subkey] VARCHAR (255),
+  [Type] LONG ,
+  [ValName] VARCHAR (255),
+  [Value] VARCHAR (255)
+)

BIN
tests/__pycache__/utilities.cpython-34.pyc


BIN
tests/initial/empty_project.zip


BIN
tests/initial/project0.zip


+ 1 - 1
tests/reference/source/database.properties

@@ -8,7 +8,7 @@ Never Cache	0	4
 AccessVersion	09.50	10
 AccessVersion	09.50	10
 NavPane Category	0	4
 NavPane Category	0	4
 Show Navigation Pane Search Bar	1	4
 Show Navigation Pane Search Bar	1	4
-Build	727	4
+Build	1150	4
 ProjVer	119	3
 ProjVer	119	3
 HasOfflineLists	70	3
 HasOfflineLists	70	3
 UseMDIMode	0	2
 UseMDIMode	0	2

+ 0 - 1
tests/reference/source/references.csv

@@ -1,4 +1,3 @@
-{B35FBDE9-7042-11D3-9C0F-00C04F72DD5F},1,0
 {4AC9E1DA-5BAD-4AC7-86E3-24F4CDCECA28},12,0
 {4AC9E1DA-5BAD-4AC7-86E3-24F4CDCECA28},12,0
 {2A75196C-D9EB-4129-B803-931327F72D5C},2,8
 {2A75196C-D9EB-4129-B803-931327F72D5C},2,8
 {420B2830-E718-11CF-893D-00A0C9054228},1,0
 {420B2830-E718-11CF-893D-00A0C9054228},1,0

+ 1 - 1
tests/reference/source/reports/ReportTest.pv

@@ -2,4 +2,4 @@
 9
 9
 2970
 2970
 2100
 2100
-0
+100

+ 0 - 0
tests/reference/source/macros/MacroTest.bas → tests/reference/source/scripts/MacroTest.bas


+ 17 - 0
tests/reference/source/scripts/test_export.bas

@@ -0,0 +1,17 @@
+Version =196611
+ColumnsShown =0
+Begin
+    Action ="RunCode"
+    Argument ="test_export()"
+End
+Begin
+    Comment ="_AXL:<?xml version=\"1.0\" encoding=\"UTF-16\" standalone=\"no\"?>\015\012<UserI"
+        "nterfaceMacro MinimumClientDesignVersion=\"14.0.0000.0000\" xmlns=\"http://schem"
+        "as.microsoft.com/office/accessservices/2009/11/application\" xmlns:a=\"http://sc"
+        "hemas.microsoft.com/office/acc"
+End
+Begin
+    Comment ="_AXL:essservices/2009/11/forms\"><Statements><Action Name=\"RunCode\"><Argument "
+        "Name=\"FunctionName\">test_export()</Argument></Action></Statements></UserInterf"
+        "aceMacro>"
+End

+ 17 - 0
tests/reference/source/scripts/test_import.bas

@@ -0,0 +1,17 @@
+Version =196611
+ColumnsShown =0
+Begin
+    Action ="RunCode"
+    Argument ="test_import()"
+End
+Begin
+    Comment ="_AXL:<?xml version=\"1.0\" encoding=\"UTF-16\" standalone=\"no\"?>\015\012<UserI"
+        "nterfaceMacro MinimumClientDesignVersion=\"14.0.0000.0000\" xmlns=\"http://schem"
+        "as.microsoft.com/office/accessservices/2009/11/application\" xmlns:a=\"http://sc"
+        "hemas.microsoft.com/office/acc"
+End
+Begin
+    Comment ="_AXL:essservices/2009/11/forms\"><Statements><Action Name=\"RunCode\"><Argument "
+        "Name=\"FunctionName\">test_import()</Argument></Action></Statements></UserInterf"
+        "aceMacro>"
+End

+ 1 - 1
tests/reference/source/tables/TableTestBaseFields.txt

@@ -1,2 +1,2 @@
 auto_number	string	long_string	integer	long_int	real	real_one_decimal	real_double	decimal	datetime	boolean	string_with_default	numeric_with_condition	nonnull_date	indexed_integer_no_decimal
 auto_number	string	long_string	integer	long_int	real	real_one_decimal	real_double	decimal	datetime	boolean	string_with_default	numeric_with_condition	nonnull_date	indexed_integer_no_decimal
-1	foo	foobar	1	1000000	1.608201E+07	1608.202	1.23123123123123E+17		27/04/2008	Vrai	default value	1	5/12/2011	123
+1	foo	foobar	1	1000000	1,608201E+07	1608,202	1,23123123123123E+17		27/04/2008	Vrai	default value	1	5/12/2011	123

+ 0 - 0
tests/reference/source/tbldef/TableTestAdvancedFields.sql → tests/reference/source/tbldefs/TableTestAdvancedFields.sql


+ 0 - 0
tests/reference/source/tbldef/TableTestBaseFields.sql → tests/reference/source/tbldefs/TableTestBaseFields.sql


+ 0 - 0
tests/reference/source/tbldef/TableTestRelation1.sql → tests/reference/source/tbldefs/TableTestRelation1.sql


+ 0 - 0
tests/reference/source/tbldef/TableTestRelation2.sql → tests/reference/source/tbldefs/TableTestRelation2.sql


+ 0 - 0
tests/reference/source/tbldef/TableTestRelation3.sql → tests/reference/source/tbldefs/TableTestRelation3.sql


+ 0 - 0
tests/reference/source/tbldef/TableTestRelation4.sql → tests/reference/source/tbldefs/TableTestRelation4.sql


+ 0 - 0
tests/reference/source/tbldef/TableTestSpecialChars_éèà@~êëç_[92]_[47]_[58]_[42]_[63]_[60]_[62]_[124].sql → tests/reference/source/tbldefs/TableTestSpecialChars_éèà@~êëç_[92]_[47]_[58]_[42]_[63]_[60]_[62]_[124].sql


+ 0 - 0
tests/reference/source/tbldef/TableWithData.sql → tests/reference/source/tbldefs/TableWithData.sql


+ 0 - 0
tests/reference/source/tbldef/TableWithProperties.sql → tests/reference/source/tbldefs/TableWithProperties.sql


+ 4 - 0
tests/reference/source/tbldefs/USysOpenAccess.sql

@@ -0,0 +1,4 @@
+CREATE TABLE [USysOpenAccess] (
+  [key] VARCHAR (255),
+  [val] VARCHAR (255)
+)

+ 0 - 0
tests/reference/source/tbldef/linked_table.LNKD → tests/reference/source/tbldefs/linked_table.LNKD


+ 36 - 3
tests/test.py

@@ -12,18 +12,21 @@ def _print_(*args):
 
 
 _print_("\n** PREPARATION **")
 _print_("\n** PREPARATION **")
 
 
-if not file.fexists("..\\OpenAccess.accda"):
-    _print_("unzip OpenAccess.zip in .\\")
-    os.system("unzip -q ..\\OpenAccess.zip -d .\\")
+_print_("\nWARNING: CLOSE ANY OPENED ACCESS PROJECT TO AVOID PROBLEMS")
 
 
 for subdir in (".\\work", ".\\results"):
 for subdir in (".\\work", ".\\results"):
     if file.fexists(subdir):
     if file.fexists(subdir):
         _print_("clean "+subdir)
         _print_("clean "+subdir)
         file.frmdir(os.path.abspath(subdir))
         file.frmdir(os.path.abspath(subdir))
+        file.fmkdir(os.path.abspath(subdir))
     else:
     else:
         _print_("make dir "+subdir)
         _print_("make dir "+subdir)
         file.fmkdir(os.path.abspath(subdir))
         file.fmkdir(os.path.abspath(subdir))
 
 
+_print_("unzip OpenAccess.zip in .\\work\\")
+os.system("unzip -q ..\\OpenAccess.zip -d .\\work\\")
+
+
 for zipped_file in ("project0.zip", "db.zip", "empty_project.zip"):
 for zipped_file in ("project0.zip", "db.zip", "empty_project.zip"):
     _print_("unzip .\\initial\\{} to .\\work".format(zipped_file))
     _print_("unzip .\\initial\\{} to .\\work".format(zipped_file))
     os.system("unzip  -q .\\initial\\{} -d .\\work".format(zipped_file))
     os.system("unzip  -q .\\initial\\{} -d .\\work".format(zipped_file))
@@ -81,6 +84,36 @@ if not file.fexists(import_project + ".old"):
     _print_(import_project + ".old do not exist")
     _print_(import_project + ".old do not exist")
     sys.exit(1)
     sys.exit(1)
 
 
+# at this point, we did a complete export of project0.accdb, 
+# then an import of the previously created sources in the empty_project.accdb
+# we now export the sources of empty_project.accdb to control the integrity of the newly created app
+
+_print_("\n** TEST RE-EXPORTS **")
+
+_print_("Delete .\\work\\source")
+file.frmdir(".\\work\\source")
+
+_print_("Export the sources from " + import_project)
+os.system( import_project + " /X test_export" )
+
+_print_("Verify the log file")
+result = utilities.verify_log(".\\work\\empty_project_2.log")
+if result != 0:
+    sys.exit(result)
+
+utilities.clean_sources( ".\\work\\source\\" )
+
+source = ".\\work\\source"
+target = ".\\results\\source2"
+_print_("Copy {} to {}".format(source, target))
+copy_tree(source, target)
+
+_print_("control the result")
+result = utilities.compare_dirs( ".\\results\\source2",  ".\\reference\\source" )
+if result != 0:
+    sys.exit(result)
+_print_(".\\results\\source2 and .\\reference\\source are identical")
+
 
 
 _print_("** end **")
 _print_("** end **")
 sys.exit(0)
 sys.exit(0)