Selaa lähdekoodia

Corrections bugs import-export (cf. issue tests > ctrl A1)

olivier.massot 9 vuotta sitten
vanhempi
commit
a56a068833

+ 2 - 2
.gitignore

@@ -1,6 +1,6 @@
 *.komodoproject
 *.komodoproject
-test\
-errors\*
+test/
+errors/
 *.accdb
 *.accdb
 *.laccdb
 *.laccdb
 *.accda
 *.accda

+ 0 - 0
erreurs import.TXT


BIN
errors/analytique_import_form.PNG


BIN
errors/analytique_import_form2.PNG


BIN
errors/analytique_import_form3.PNG


BIN
errors/analytique_import_printvars.PNG


BIN
errors/analytique_import_report.PNG


BIN
errors/autorisation_tbl.PNG


BIN
errors/autorisation_tbl_2.PNG


+ 76 - 0
source/modules/VCS_Controls.bas

@@ -0,0 +1,76 @@
+Option Compare Database
+
+'****
+'*
+'* VCS checks
+'*
+'****
+
+
+Sub diagnostic()
+    Dim obj As Object
+    Dim count As Integer
+    Dim td As TableDef
+    Dim qd As QueryDef
+    
+    Dim oFSO As Object
+    Set oFSO = CreateObject("Scripting.FileSystemObject")
+    Dim oFile As Object
+    Set oFile = oFSO.CreateTextFile("c:\applis_parc\ztest\diag_" & CurrentProject.name & ".txt", ForAppending)
+    
+    
+    oFile.WriteLine ("# tbl def")
+    count = 0
+    For Each td In CurrentDb.TableDefs
+        'Debug.Print td.Name
+        oFile.WriteLine td.name
+        count = count + 1
+    Next
+    Debug.Print "tbldef", count
+    
+    oFile.WriteLine ("# query def")
+    count = 0
+    For Each qd In CurrentDb.QueryDefs
+        'Debug.Print qd.Name
+        oFile.WriteLine qd.name
+        count = count + 1
+    Next
+    Debug.Print "queries", count
+    
+    oFile.WriteLine ("# reports")
+    count = 0
+    For Each obj In CurrentProject.AllReports()
+        'Debug.Print obj.Name
+        oFile.WriteLine obj.name
+        count = count + 1
+    Next
+    Debug.Print "reports", count
+    
+    oFile.WriteLine ("# forms")
+    count = 0
+    For Each obj In CurrentProject.AllForms()
+        'Debug.Print obj.Name
+        oFile.WriteLine obj.name
+        count = count + 1
+    Next
+    Debug.Print "forms", count
+    
+    oFile.WriteLine ("# macros")
+    count = 0
+    For Each obj In CurrentProject.AllMacros()
+        'Debug.Print obj.Name
+        oFile.WriteLine obj.name
+        count = count + 1
+    Next
+    Debug.Print "macros", count
+    
+    oFile.WriteLine ("# modules")
+    count = 0
+    For Each obj In CurrentProject.AllModules()
+        oFile.WriteLine obj.name
+        'Debug.Print obj.Name
+        count = count + 1
+    Next
+    Debug.Print "modules", count
+    
+End Sub

+ 10 - 10
source/modules/VCS_DataMacro.bas

@@ -11,12 +11,12 @@ Option Explicit
 
 
 Public Sub ExportDataMacros(ByVal tableName As String, ByVal directory As String)
 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
     
     
-    filePath = directory & tableName & ".xml"
+    filepath = directory & tableName & ".xml"
 
 
-    VCS_IE_Functions.ExportObject acTableDataMacro, tableName, filePath, VCS_File.UsingUcs2
-    FormatDataMacro filePath
+    VCS_IE_Functions.ExportObject acTableDataMacro, tableName, filepath, VCS_File.UsingUcs2
+    FormatDataMacro filepath
 
 
     Exit Sub
     Exit Sub
 
 
@@ -26,10 +26,10 @@ End Sub
 
 
 Public Sub ImportDataMacros(ByVal tableName As String, ByVal directory As String)
 Public Sub ImportDataMacros(ByVal tableName As String, ByVal directory As String)
     On Error GoTo Err_import
     On Error GoTo Err_import
-    Dim filePath As String
+    Dim filepath As String
     
     
-    filePath = directory & tableName & ".xml"
-    VCS_IE_Functions.ImportObject acTableDataMacro, tableName, filePath, VCS_File.UsingUcs2
+    filepath = directory & tableName & ".xml"
+    VCS_IE_Functions.ImportObject acTableDataMacro, tableName, filepath, VCS_File.UsingUcs2
     
     
     Exit Sub
     Exit Sub
     
     
@@ -39,7 +39,7 @@ End Sub
 
 
 'Splits exported DataMacro XML onto multiple lines
 'Splits exported DataMacro XML onto multiple lines
 'Allows git to find changes within lines using diff
 'Allows git to find changes within lines using diff
-Private Sub FormatDataMacro(ByVal filePath As String)
+Private Sub FormatDataMacro(ByVal filepath As String)
 
 
     Dim saveStream As Object 'ADODB.Stream
     Dim saveStream As Object 'ADODB.Stream
 
 
@@ -55,7 +55,7 @@ Private Sub FormatDataMacro(ByVal filePath As String)
     objStream.Charset = "utf-8"
     objStream.Charset = "utf-8"
     objStream.Type = 2 'adTypeText
     objStream.Type = 2 'adTypeText
     objStream.Open
     objStream.Open
-    objStream.LoadFromFile (filePath)
+    objStream.LoadFromFile (filepath)
     
     
     Do While Not objStream.EOS
     Do While Not objStream.EOS
         strData = objStream.ReadText(-2) 'adReadLine
         strData = objStream.ReadText(-2) 'adReadLine
@@ -71,7 +71,7 @@ Private Sub FormatDataMacro(ByVal filePath As String)
     Loop
     Loop
     
     
     objStream.Close
     objStream.Close
-    saveStream.SaveToFile filePath, 2 'adSaveCreateOverWrite
+    saveStream.SaveToFile filepath, 2 'adSaveCreateOverWrite
     saveStream.Close
     saveStream.Close
 
 
 End Sub
 End Sub

+ 9 - 9
source/modules/VCS_Dir.bas

@@ -6,7 +6,7 @@ Option Explicit
 
 
 ' Path/Directory of the current database file.
 ' Path/Directory of the current database file.
 Public Function ProjectPath() As String
 Public Function ProjectPath() As String
-    ProjectPath = CurrentProject.Path
+    ProjectPath = CurrentProject.path
     If Right$(ProjectPath, 1) <> "\" Then ProjectPath = ProjectPath & "\"
     If Right$(ProjectPath, 1) <> "\" Then ProjectPath = ProjectPath & "\"
 End Function
 End Function
 
 
@@ -16,23 +16,23 @@ Public Function SourcePath() As String
 End Function
 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)
     On Error GoTo MkDirIfNotexist_noop
     On Error GoTo MkDirIfNotexist_noop
-    MkDir Path
+    MkDir path
 MkDirIfNotexist_noop:
 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
 DelIfNotExist_Noop:
 DelIfNotExist_Noop:
     On Error GoTo 0
     On Error GoTo 0
 End Sub
 End Sub
 
 
 ' Erase all *.`ext` files in `Path`.
 ' Erase all *.`ext` files in `Path`.
-Public Sub ClearTextFilesFromDir(ByVal Path As String, ByVal Ext As String, Optional ByVal force As Boolean = False)
+Public Sub ClearTextFilesFromDir(ByVal path As String, ByVal Ext As String, Optional ByVal force As Boolean = False)
     
     
     '### 13/10/2016: add optimizer
     '### 13/10/2016: add optimizer
     ' we don't want to clear the text files of the objects which will not be exported
     ' we don't want to clear the text files of the objects which will not be exported
@@ -44,11 +44,11 @@ Public Sub ClearTextFilesFromDir(ByVal Path As String, ByVal Ext As String, Opti
     
     
     Dim fso As Object
     Dim fso As Object
     Set fso = CreateObject("Scripting.FileSystemObject")
     Set fso = CreateObject("Scripting.FileSystemObject")
-    If Not fso.FolderExists(Path) Then Exit Sub
+    If Not fso.FolderExists(path) Then Exit Sub
 
 
     On Error GoTo ClearTextFilesFromDir_noop
     On Error GoTo ClearTextFilesFromDir_noop
-    If dir$(Path & "*." & Ext) <> vbNullString Then
-        fso.DeleteFile Path & "*." & Ext
+    If dir$(path & "*." & Ext) <> vbNullString Then
+        fso.DeleteFile path & "*." & Ext
     End If
     End If
     
     
 ClearTextFilesFromDir_noop:
 ClearTextFilesFromDir_noop:

+ 19 - 0
source/modules/VCS_File.bas

@@ -170,6 +170,8 @@ Public Sub ConvertUtf8Ucs2(ByVal Source As String, ByVal dest As String)
     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
@@ -252,6 +254,23 @@ Public Function UsingUcs2() As Boolean
     fso.DeleteFile (tempFileName)
     fso.DeleteFile (tempFileName)
 End Function
 End Function
 
 
+Public Function ReadFile(filepath As String, Optional encoding As String = "utf-8") As String
+    Dim objStream As ADODB.Stream
+    Set objStream = New ADODB.Stream
+
+    objStream.Charset = "x-ansi"
+    objStream.Open
+    objStream.LoadFromFile (filepath)
+    ReadFile = objStream.ReadText()
+    
+    objStream.Close
+    Set objStream = Nothing
+End Function
+
+
+
+
+
 ' Generate Random / Unique tempprary file name.
 ' Generate Random / Unique tempprary file name.
 Public Function TempFile(Optional ByVal sPrefix As String = "VBA") As String
 Public Function TempFile(Optional ByVal sPrefix As String = "VBA") As String
     Dim sTmpPath As String * 512
     Dim sTmpPath As String * 512

+ 2 - 2
source/modules/VCS_Git.bas

@@ -2,7 +2,7 @@ Option Compare Database
 
 
 Public Function is_git_repo() As Boolean
 Public Function is_git_repo() As Boolean
 ' returns True if current app dir is a git repository
 ' returns True if current app dir is a git repository
-    is_git_repo = (dir(CurrentProject.Path & "\.git\", vbDirectory) <> "")
+    is_git_repo = (dir(CurrentProject.path & "\.git\", vbDirectory) <> "")
     
     
 End Function
 End Function
 
 
@@ -21,7 +21,7 @@ Public Function complete_gitignore()
     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"
     
     
     Dim fso As Object
     Dim fso As Object
     Set fso = CreateObject("Scripting.FileSystemObject")
     Set fso = CreateObject("Scripting.FileSystemObject")

+ 86 - 11
source/modules/VCS_IE_Functions.bas

@@ -10,6 +10,9 @@ Private Const StripPublishOption As Boolean = True
 Public Const ForReading = 1, ForWriting = 2, ForAppending = 8
 Public Const ForReading = 1, ForWriting = 2, ForAppending = 8
 Public Const TristateTrue = -1, TristateFalse = 0, TristateUseDefault = -2
 Public Const TristateTrue = -1, TristateFalse = 0, TristateUseDefault = -2
 
 
+' constants for names conversion
+Public Const ForbiddenCars = "34,42,47,58,60,62,63,92,124"
+
 
 
 ' Can we export without closing the form?
 ' Can we export without closing the form?
 
 
@@ -17,13 +20,17 @@ Public Const TristateTrue = -1, TristateFalse = 0, TristateUseDefault = -2
 Public Sub ExportObject(ByVal obj_type_num As Integer, ByVal obj_name As String, _
 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)
                     ByVal file_path As String, Optional ByVal Ucs2Convert As Boolean = False)
 
 
-
     VCS_Dir.MkDirIfNotExist Left$(file_path, InStrRev(file_path, "\"))
     VCS_Dir.MkDirIfNotExist Left$(file_path, InStrRev(file_path, "\"))
+    
     If Ucs2Convert Then
     If Ucs2Convert Then
         Dim tempFileName As String
         Dim tempFileName As String
         tempFileName = VCS_File.TempFile()
         tempFileName = VCS_File.TempFile()
         Application.SaveAsText obj_type_num, obj_name, tempFileName
         Application.SaveAsText obj_type_num, obj_name, tempFileName
         VCS_File.ConvertUcs2Utf8 tempFileName, file_path
         VCS_File.ConvertUcs2Utf8 tempFileName, file_path
+
+        Dim fso As Object
+        Set fso = CreateObject("Scripting.FileSystemObject")
+        fso.DeleteFile tempFileName
     Else
     Else
         Application.SaveAsText obj_type_num, obj_name, file_path
         Application.SaveAsText obj_type_num, obj_name, file_path
     End If
     End If
@@ -33,12 +40,18 @@ End Sub
 Public Sub ImportObject(ByVal obj_type_num As Integer, ByVal obj_name As String, _
 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)
                     ByVal file_path As String, Optional ByVal Ucs2Convert As Boolean = False)
     
     
-    If Not VCS_Dir.FileExists(file_path) Then Exit Sub
+    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
     If Ucs2Convert Then
         Dim tempFileName As String
         Dim tempFileName As String
         tempFileName = VCS_File.TempFile()
         tempFileName = VCS_File.TempFile()
         VCS_File.ConvertUtf8Ucs2 file_path, tempFileName
         VCS_File.ConvertUtf8Ucs2 file_path, tempFileName
+        
         Application.LoadFromText obj_type_num, obj_name, tempFileName
         Application.LoadFromText obj_type_num, obj_name, tempFileName
         
         
         Dim fso As Object
         Dim fso As Object
@@ -47,6 +60,9 @@ Public Sub ImportObject(ByVal obj_type_num As Integer, ByVal obj_name As String,
     Else
     Else
         Application.LoadFromText obj_type_num, obj_name, file_path
         Application.LoadFromText obj_type_num, obj_name, file_path
     End If
     End If
+Exit Sub
+err:
+    logger "ImportObject", "CRITICAL", "Unable to import the object " & obj_name & " (" & obj_type_num & ")" & "[" & err.Description & "]"
 End Sub
 End Sub
 
 
 'shouldn't this be SanitizeTextFile (Singular)?
 'shouldn't this be SanitizeTextFile (Singular)?
@@ -55,7 +71,7 @@ End Sub
 ' unnecessary lines of VB code that are inserted automatically by the
 ' 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
 ' Access GUI and change often (we don't want these lines of code in
 ' version control).
 ' version control).
-Public Sub SanitizeTextFiles(ByVal Path As String, ByVal Ext As String)
+Public Sub SanitizeTextFiles(ByVal path As String, ByVal Ext As String)
 
 
     Dim fso As Object
     Dim fso As Object
     Set fso = CreateObject("Scripting.FileSystemObject")
     Set fso = CreateObject("Scripting.FileSystemObject")
@@ -68,6 +84,7 @@ Public Sub SanitizeTextFiles(ByVal Path As String, ByVal Ext As String)
     '  Match PrtDevNames / Mode with or  without W
     '  Match PrtDevNames / Mode with or  without W
     Dim srchPattern As String
     Dim srchPattern As String
     srchPattern = "PrtDev(?:Names|Mode)[W]?"
     srchPattern = "PrtDev(?:Names|Mode)[W]?"
+    
     If (AggressiveSanitize = True) Then
     If (AggressiveSanitize = True) Then
       '  Add and group aggressive matches
       '  Add and group aggressive matches
       srchPattern = "(?:" & srchPattern
       srchPattern = "(?:" & srchPattern
@@ -93,7 +110,7 @@ Public Sub SanitizeTextFiles(ByVal Path As String, ByVal Ext As String)
 'Debug.Print srchPattern
 'Debug.Print srchPattern
     rxLine.Pattern = srchPattern
     rxLine.Pattern = srchPattern
     Dim filename As String
     Dim filename As String
-    filename = dir$(Path & "*." & Ext)
+    filename = dir$(path & "*." & Ext)
     Dim isReport As Boolean
     Dim isReport As Boolean
     isReport = False
     isReport = False
     
     
@@ -103,9 +120,9 @@ Public Sub SanitizeTextFiles(ByVal Path As String, ByVal Ext As String)
         obj_name = Mid$(filename, 1, InStrRev(filename, ".") - 1)
         obj_name = Mid$(filename, 1, InStrRev(filename, ".") - 1)
 
 
         Dim InFile As Object
         Dim InFile As Object
-        Set InFile = fso.OpenTextFile(Path & obj_name & "." & Ext, iomode:=ForReading, create:=False, Format:=TristateFalse)
+        Set InFile = fso.OpenTextFile(path & obj_name & "." & Ext, iomode:=ForReading, create:=False, Format:=TristateFalse)
         Dim OutFile As Object
         Dim OutFile As Object
-        Set OutFile = fso.CreateTextFile(Path & obj_name & ".sanitize", overwrite:=True, Unicode:=False)
+        Set OutFile = fso.CreateTextFile(path & obj_name & ".sanitize", overwrite:=True, unicode:=False)
     
     
         Dim getLine As Boolean
         Dim getLine As Boolean
         getLine = True
         getLine = True
@@ -136,11 +153,12 @@ Public Sub SanitizeTextFiles(ByVal Path As String, ByVal Ext As String)
                     Case 0
                     Case 0
                         rxIndent.Pattern = "^" & vbNullString
                         rxIndent.Pattern = "^" & vbNullString
                     Case Else
                     Case Else
-                        rxIndent.Pattern = "^" & matches(0).SubMatches(0)
+                        rxIndent.Pattern = "^(\s{0," & Len(matches(0).SubMatches(0)) & "})"
                 End Select
                 End Select
                 rxIndent.Pattern = rxIndent.Pattern + "\S"
                 rxIndent.Pattern = rxIndent.Pattern + "\S"
                 '
                 '
                 ' Skip lines with deeper indentation
                 ' Skip lines with deeper indentation
+
                 Do Until InFile.AtEndOfStream
                 Do Until InFile.AtEndOfStream
                     txt = InFile.readline
                     txt = InFile.readline
                     If rxIndent.test(txt) Then Exit Do
                     If rxIndent.test(txt) Then Exit Do
@@ -170,12 +188,69 @@ Public Sub SanitizeTextFiles(ByVal Path As String, ByVal Ext As String)
         OutFile.Close
         OutFile.Close
         InFile.Close
         InFile.Close
 
 
-        fso.DeleteFile (Path & filename)
+        fso.DeleteFile (path & filename)
 
 
         Dim thisFile As Object
         Dim thisFile As Object
-        Set thisFile = fso.GetFile(Path & obj_name & ".sanitize")
-        thisFile.Move (Path & filename)
+        Set thisFile = fso.GetFile(path & obj_name & ".sanitize")
+        thisFile.Move (path & filename)
         filename = dir$()
         filename = dir$()
     Loop
     Loop
 
 
-End Sub
+End Sub
+
+Public Function to_filename(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
+
+    to_filename = result
+Exit Function
+err:
+    Call logger("to_accessname", "ERROR", "Unable to convert object's name " & object_name & " to file's name")
+    to_filename = object_name
+End Function
+
+Public Function to_accessname(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
+
+    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

+ 22 - 21
source/modules/VCS_ImportExport.bas

@@ -61,6 +61,7 @@ Public Sub ExportAllSource()
     Dim obj_count As Integer
     Dim obj_count As Integer
     Dim obj_data_count As Integer
     Dim obj_data_count As Integer
     Dim ucs2 As Boolean
     Dim ucs2 As Boolean
+    Dim full_path As String
 
 
     include_tables = get_include_tables()
     include_tables = get_include_tables()
     
     
@@ -75,6 +76,7 @@ Public Sub ExportAllSource()
     obj_path = source_path & "queries\"
     obj_path = source_path & "queries\"
     VCS_Dir.ClearTextFilesFromDir obj_path, "bas"
     VCS_Dir.ClearTextFilesFromDir obj_path, "bas"
     
     
+    
     Debug.Print VCS_String.PadRight("Exporting queries...", 24);
     Debug.Print VCS_String.PadRight("Exporting queries...", 24);
     
     
     obj_count = 0
     obj_count = 0
@@ -82,22 +84,17 @@ Public Sub ExportAllSource()
     
     
         '### 11/10/2016: add optimizer
         '### 11/10/2016: add optimizer
         If optimizer_activated() Then
         If optimizer_activated() Then
-            If Not is_dirty(acQuery, qry.name) Then
+            If Not needs_export(acQuery, qry.name) > 0 Then
                 obj_count = obj_count + 1
                 obj_count = obj_count + 1
                 GoTo next_qry
                 GoTo next_qry
             End If
             End If
         End If
         End If
         '###
         '###
-
-        If Not IsValidFileName(qry.name) Then
-            Debug.Print "ERROR:" & qry.name & " is not a valid file name, query has been ignored"
-            obj_count = obj_count + 1
-            GoTo next_qry
-        End If
         
         
         DoEvents
         DoEvents
         If Left$(qry.name, 1) <> "~" Then
         If Left$(qry.name, 1) <> "~" Then
-            VCS_IE_Functions.ExportObject acQuery, qry.name, obj_path & qry.name & ".bas", VCS_File.UsingUcs2
+            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
             obj_count = obj_count + 1
         End If
         End If
         
         
@@ -134,7 +131,7 @@ next_qry:
         
         
             '### 11/10/2016: add optimizer
             '### 11/10/2016: add optimizer
             If optimizer_activated() Then
             If optimizer_activated() Then
-                If Not is_dirty(obj_type_num, doc.name) Then
+                If Not needs_export(obj_type_num, doc.name) > 0 Then
                     obj_count = obj_count + 1
                     obj_count = obj_count + 1
                     GoTo next_doc
                     GoTo next_doc
                 End If
                 End If
@@ -143,12 +140,6 @@ next_qry:
         
         
             DoEvents
             DoEvents
             
             
-            If Not IsValidFileName(doc.name) Then
-                Debug.Print "ERROR:" & doc.name & " is not a valid file name, " & obj_type_name & " has been ignored"
-                obj_count = obj_count + 1
-                GoTo next_doc
-            End If
-            
             If (Left$(doc.name, 1) <> "~") And _
             If (Left$(doc.name, 1) <> "~") And _
                (IsNotVCS(doc.name) Or ArchiveMyself) Then
                (IsNotVCS(doc.name) Or ArchiveMyself) Then
                 If obj_type_label = "modules" Then
                 If obj_type_label = "modules" Then
@@ -156,9 +147,12 @@ next_qry:
                 Else
                 Else
                     ucs2 = VCS_File.UsingUcs2
                     ucs2 = VCS_File.UsingUcs2
                 End If
                 End If
-                VCS_IE_Functions.ExportObject obj_type_num, doc.name, obj_path & doc.name & ".bas", ucs2
+                
+                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
                 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"
                     VCS_Report.ExportPrintVars doc.name, obj_path & doc.name & ".pv"
                 End If
                 End If
                 
                 
@@ -221,7 +215,7 @@ next_doc:
         '### 11/10/2016: add optimizer
         '### 11/10/2016: add optimizer
         'only update the table definition if this is a complete export
         'only update the table definition if this is a complete export
         'or if the table definition has been modified since last export
         'or if the table definition has been modified since last export
-        update_this_tabledef = (Not optimizer_activated() Or is_dirty(acTable, td.name))
+        update_this_tabledef = (Not optimizer_activated() Or needs_export(acTable, td.name) > 0)
         '###
         '###
     
     
         If Not IsValidFileName(td.name) Then
         If Not IsValidFileName(td.name) Then
@@ -239,7 +233,7 @@ next_doc:
             If Len(td.connect) = 0 Then ' this is not an external table
             If Len(td.connect) = 0 Then ' this is not an external table
                 
                 
                 If update_this_tabledef Then
                 If update_this_tabledef Then
-                    VCS_Table.ExportTableDef Db, td, td.name, obj_path
+                    VCS_Table.ExportTableDef Db, td, VCS_IE_Functions.to_filename(td.name), obj_path
                 End If
                 End If
                 
                 
                 If include_tables = "*" Then
                 If include_tables = "*" Then
@@ -346,8 +340,8 @@ Public Sub ImportAllSource()
 
 
     source_path = VCS_Dir.ProjectPath() & "source\"
     source_path = VCS_Dir.ProjectPath() & "source\"
     If Not fso.FolderExists(source_path) Then
     If Not fso.FolderExists(source_path) Then
-        MsgBox "No source found at:" & vbCrLf & source_path, vbExclamation, "Import failed"
-        Exit Sub
+        logger "ImportAllSource", "CRITICAL", "No source found at:" & source_path
+        Call err.Raise(60000, "Critical error", "Critical error occured, see the log file for more informations")
     End If
     End If
 
 
     Debug.Print
     Debug.Print
@@ -369,6 +363,7 @@ Public Sub ImportAllSource()
         Do Until Len(filename) = 0
         Do Until Len(filename) = 0
             DoEvents
             DoEvents
             obj_name = Mid$(filename, 1, InStrRev(filename, ".") - 1)
             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.ImportObject acQuery, obj_name, obj_path & filename, VCS_File.UsingUcs2
             VCS_IE_Functions.ExportObject acQuery, obj_name, tempFilePath, 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
             VCS_IE_Functions.ImportObject acQuery, obj_name, tempFilePath, VCS_File.UsingUcs2
@@ -391,6 +386,7 @@ Public Sub ImportAllSource()
         obj_count = 0
         obj_count = 0
         Do Until Len(filename) = 0
         Do Until Len(filename) = 0
             obj_name = Mid$(filename, 1, InStrRev(filename, ".") - 1)
             obj_name = Mid$(filename, 1, InStrRev(filename, ".") - 1)
+            obj_name = VCS_IE_Functions.to_accessname(obj_name)
             If DebugOutput Then
             If DebugOutput Then
                 If obj_count = 0 Then
                 If obj_count = 0 Then
                     Debug.Print
                     Debug.Print
@@ -415,6 +411,7 @@ Public Sub ImportAllSource()
         obj_count = 0
         obj_count = 0
         Do Until Len(filename) = 0
         Do Until Len(filename) = 0
             obj_name = Mid$(filename, 1, InStrRev(filename, ".") - 1)
             obj_name = Mid$(filename, 1, InStrRev(filename, ".") - 1)
+            obj_name = VCS_IE_Functions.to_accessname(obj_name)
             If DebugOutput Then
             If DebugOutput Then
                 If obj_count = 0 Then
                 If obj_count = 0 Then
                     Debug.Print
                     Debug.Print
@@ -441,6 +438,7 @@ Public Sub ImportAllSource()
         Do Until Len(filename) = 0
         Do Until Len(filename) = 0
             DoEvents
             DoEvents
             obj_name = Mid$(filename, 1, InStrRev(filename, ".") - 1)
             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_Table.ImportTableData CStr(obj_name), obj_path
             obj_count = obj_count + 1
             obj_count = obj_count + 1
             filename = dir$()
             filename = dir$()
@@ -460,6 +458,7 @@ Public Sub ImportAllSource()
         Do Until Len(filename) = 0
         Do Until Len(filename) = 0
             DoEvents
             DoEvents
             obj_name = Mid$(filename, 1, InStrRev(filename, ".") - 1)
             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_Table.ImportTableData CStr(obj_name), obj_path
             VCS_DataMacro.ImportDataMacros obj_name, obj_path
             VCS_DataMacro.ImportDataMacros obj_name, obj_path
             obj_count = obj_count + 1
             obj_count = obj_count + 1
@@ -494,6 +493,7 @@ Public Sub ImportAllSource()
             Do Until Len(filename) = 0
             Do Until Len(filename) = 0
                 ' DoEvents no good idea!
                 ' DoEvents no good idea!
                 obj_name = Mid$(filename, 1, InStrRev(filename, ".") - 1)
                 obj_name = Mid$(filename, 1, InStrRev(filename, ".") - 1)
+                obj_name = VCS_IE_Functions.to_accessname(obj_name)
                 If obj_type_label = "modules" Then
                 If obj_type_label = "modules" Then
                     ucs2 = False
                     ucs2 = False
                 Else
                 Else
@@ -504,7 +504,7 @@ Public Sub ImportAllSource()
                     obj_count = obj_count + 1
                     obj_count = obj_count + 1
                 Else
                 Else
                     If ArchiveMyself Then
                     If ArchiveMyself Then
-                            MsgBox "Module " & obj_name & " could not be updated while running. Ensure latest version is included!", vbExclamation, "Warning"
+                        logger "ImportAllSource", "WARNING", "Module " & obj_name & " could not be updated while running. Ensure latest version is included!"
                     End If
                     End If
                 End If
                 End If
                 filename = dir$()
                 filename = dir$()
@@ -527,6 +527,7 @@ Public Sub ImportAllSource()
     Do Until Len(filename) = 0
     Do Until Len(filename) = 0
         DoEvents
         DoEvents
         obj_name = Mid$(filename, 1, InStrRev(filename, ".") - 1)
         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
         VCS_Report.ImportPrintVars obj_name, obj_path & filename
         obj_count = obj_count + 1
         obj_count = obj_count + 1
         filename = dir$()
         filename = dir$()

+ 1 - 1
source/modules/VCS_Loader.bas

@@ -4,7 +4,7 @@ Option Explicit
 
 
 Public Sub loadVCS(Optional ByVal SourceDirectory As String)
 Public Sub loadVCS(Optional ByVal SourceDirectory As String)
     If SourceDirectory = vbNullString Then
     If SourceDirectory = vbNullString Then
-      SourceDirectory = CurrentProject.Path & "\MSAccess-VCS\"
+      SourceDirectory = CurrentProject.path & "\MSAccess-VCS\"
     End If
     End If
 
 
 'check if directory exists! - SourceDirectory could be a file or not exist
 'check if directory exists! - SourceDirectory could be a file or not exist

+ 34 - 0
source/modules/VCS_Log.bas

@@ -0,0 +1,34 @@
+Option Compare Database
+Dim log_file_path As String
+
+Public Function log_file()
+    log_file = log_file_path
+End Function
+
+Public Sub logger(origin As String, level As String, msg As String)
+    Dim fso As Object
+    Dim oFile As Object
+
+    Set fso = CreateObject("Scripting.FileSystemObject")
+
+    If Not Len(log_file_path) > 0 Then
+    
+        log_file_path = CurrentProject.path & "\" & "logVCS_" & Format(Now, "yymmdd_hhMMss") & ".log"
+        
+        Debug.Print log_file_path
+        If Not fso.FileExists(log_file_path) Then
+            Set oFile = fso.CreateTextFile(log_file_path)
+            oFile.Close
+        End If
+        
+    End If
+
+    Set oFile = fso.OpenTextFile(log_file_path, ForAppending)
+
+    'oFile.WriteBlankLines (2)
+    oFile.WriteLine (CStr(Now) + " - " + origin + " - " + level + " - " + msg)
+    
+    oFile.Close
+    Set fso = Nothing
+    Set oFile = Nothing
+End Sub

+ 24 - 17
source/modules/VCS_Main.bas

@@ -37,7 +37,7 @@ Dim step As String
         
         
         If old_sources_date > #1/1/1900# Then
         If old_sources_date > #1/1/1900# Then
 
 
-            msg = msg_list_modified()
+            msg = msg_list_to_export()
             
             
             If Not Len(msg) > 0 Then
             If Not Len(msg) > 0 Then
                 msg = "** VCS OPTIMIZER **" & vbNewLine & ">> Nothing new to export" & vbNewLine & _
                 msg = "** VCS OPTIMIZER **" & vbNewLine & ">> Nothing new to export" & vbNewLine & _
@@ -46,7 +46,11 @@ Dim step As String
                             " - relations" & vbNewLine & vbNewLine & _
                             " - relations" & vbNewLine & vbNewLine & _
                             "TIP: use 'makesources -f' to force a complete export (could be long)."
                             "TIP: use 'makesources -f' to force a complete export (could be long)."
             Else
             Else
-                msg = "** VCS OPTIMIZER **" & vbNewLine & ">> Following objects will be exported:" & vbNewLine & msg
+                msg = "** VCS OPTIMIZER **" & vbNewLine & _
+                      ">> Following objects will be exported:" & vbNewLine & _
+                      msg & vbNewLine & _
+                      "> DATA: " & vbNewLine & get_include_tables() & vbNewLine & vbNewLine & _
+                      "> RELATIONS"
             End If
             End If
             
             
             Call activate_optimizer
             Call activate_optimizer
@@ -113,15 +117,16 @@ update_from_sources = opInterrupted
 
 
     step = "Check for unexported work"
     step = "Check for unexported work"
     Debug.Print step
     Debug.Print step
-    msg = msg_list_modified()
+    msg = msg_list_to_export()
     If Len(msg) > 0 Then
     If Len(msg) > 0 Then
         msg = "** IMPORT WARNING **" & vbNewLine & _
         msg = "** IMPORT WARNING **" & vbNewLine & _
                     UCase(CurrentProject.name) & " is going to be updated " & _
                     UCase(CurrentProject.name) & " is going to be updated " & _
                     "with the source files. " & vbNewLine & vbNewLine & _
                     "with the source files. " & vbNewLine & vbNewLine & _
-                    "FOLLOWING NON EXPORTED WORK WILL BE LOST: " & vbNewLine & _
+                    "(!) FOLLOWING NON EXPORTED WORK WILL BE LOST (!): " & vbNewLine & _
                     msg & vbNewLine & _
                     msg & vbNewLine & _
                     "Are you sure you want to continue?"
                     "Are you sure you want to continue?"
         If MsgBox(msg, vbOKCancel + vbExclamation, "Warning") = vbCancel Then GoTo cancelOp
         If MsgBox(msg, vbOKCancel + vbExclamation, "Warning") = vbCancel Then GoTo cancelOp
+        If MsgBox("Really sure?", vbOKCancel + vbQuestion, "Warning") = vbCancel Then GoTo cancelOp
     End If
     End If
 
 
     step = "Run VCS Import"
     step = "Run VCS Import"
@@ -129,6 +134,12 @@ update_from_sources = opInterrupted
     Call ImportAllSource
     Call ImportAllSource
     Debug.Print "> done"
     Debug.Print "> done"
    
    
+    ' new sources date to keep the optimizer working
+    step = "Updates sources date"
+    Debug.Print step
+    Call update_sources_date
+    Debug.Print "> done"
+   
     update_from_sources = opCompleted
     update_from_sources = opCompleted
     Exit Function
     Exit Function
 err:
 err:
@@ -185,11 +196,7 @@ End Function
 
 
 
 
 Public Function get_include_tables()
 Public Function get_include_tables()
-    If CurrentProject.name = "VCS.accda" Then
-        get_include_tables = "tbl_commands,modele_ztbl_vcs"
-    Else
-        get_include_tables = vcs_param("include_tables")
-    End If
+    get_include_tables = vcs_param("include_tables")
 End Function
 End Function
 
 
 Public Function vcs_param(ByVal key As String, Optional ByVal default_value As String = "") As String
 Public Function vcs_param(ByVal key As String, Optional ByVal default_value As String = "") As String
@@ -209,17 +216,17 @@ Public Function zip_app_file() As Boolean
     shortname = Split(CurrentProject.name, ".")(0)
     shortname = Split(CurrentProject.name, ".")(0)
     
     
     'run the shell comand
     'run the shell comand
-    Call cmd("cd " & CurrentProject.Path & " & " & _
+    Call cmd("cd " & CurrentProject.path & " & " & _
              "zip tmp_" & shortname & ".zip " & CurrentProject.name & _
              "zip tmp_" & shortname & ".zip " & CurrentProject.name & _
              " & exit")
              " & exit")
     
     
     'remove the old zip file
     'remove the old zip file
-    If dir(CurrentProject.Path & "\" & shortname & ".zip") <> "" Then
-        Kill CurrentProject.Path & "\" & shortname & ".zip"
+    If dir(CurrentProject.path & "\" & shortname & ".zip") <> "" Then
+        Kill CurrentProject.path & "\" & shortname & ".zip"
     End If
     End If
     
     
     'rename the temporary zip
     'rename the temporary zip
-    Call cmd("cd " & CurrentProject.Path & " & " & _
+    Call cmd("cd " & CurrentProject.path & " & " & _
             "ren tmp_" & shortname & ".zip" & " " & shortname & ".zip" & _
             "ren tmp_" & shortname & ".zip" & " " & shortname & ".zip" & _
             " & exit")
             " & exit")
     
     
@@ -240,12 +247,12 @@ Public Function make_backup() As Boolean
     On Error GoTo err
     On Error GoTo err
     
     
     make_backup = False
     make_backup = False
-    If dir(CurrentProject.Path & "\" & CurrentProject.name & ".old") <> "" Then
-        Kill CurrentProject.Path & "\" & CurrentProject.name & ".old"
+    If dir(CurrentProject.path & "\" & CurrentProject.name & ".old") <> "" Then
+        Kill CurrentProject.path & "\" & CurrentProject.name & ".old"
     End If
     End If
 
 
-    Call cmd("copy " & Chr(34) & CurrentProject.Path & "\" & CurrentProject.name & Chr(34) & _
-             " " & Chr(34) & CurrentProject.Path & "\" & CurrentProject.name & ".old" & Chr(34))
+    Call cmd("copy " & Chr(34) & CurrentProject.path & "\" & CurrentProject.name & Chr(34) & _
+             " " & Chr(34) & CurrentProject.path & "\" & CurrentProject.name & ".old" & Chr(34))
     
     
     make_backup = True
     make_backup = True
     Exit Function
     Exit Function

+ 74 - 20
source/modules/VCS_Optimizer.bas

@@ -10,6 +10,11 @@ Option Explicit
 ' *** activates the optimizer
 ' *** activates the optimizer
 Private p_optimizer As Boolean
 Private p_optimizer As Boolean
 
 
+'needs_export
+Public Const NoExportNeeded = 0
+Public Const MissingFiles = 1
+Public Const UpdateNeeded = 2
+
 Public Sub activate_optimizer()
 Public Sub activate_optimizer()
     p_optimizer = True
     p_optimizer = True
 End Sub
 End Sub
@@ -21,17 +26,26 @@ End Function
 
 
 
 
 '*** main methods
 '*** main methods
-Public Function is_dirty(acType As Integer, name As String)
-' has the object been modified since last export?
-
-    is_dirty = (get_last_update_date(acType, name) > get_sources_date)
+Public Function needs_export(acType As Integer, name As String) As Integer
+    ' a file needs to be export if it has been updated since last export, or if its source files are missing
+    ' returns an integer (see constants)
+    
+    If Not files_exist_for(acType, name) Then
+        needs_export = MissingFiles
+    
+    ElseIf get_last_update_date(acType, name) > get_sources_date() Then
+        needs_export = UpdateNeeded
+        
+    Else
+        needs_export = NoExportNeeded
+    End If
 
 
 End Function
 End Function
 
 
 
 
 Public Function get_last_update_date(ByVal acType As Integer, ByVal name As String)
 Public Function get_last_update_date(ByVal acType As Integer, ByVal name As String)
-On Error GoTo err
-'get the date of the last update of an object
+    On Error GoTo err
+    'get the date of the last update of an object
 
 
     Select Case acType
     Select Case acType
         'case table or query: get [DateUpdate] in MSysObjects
         'case table or query: get [DateUpdate] in MSysObjects
@@ -60,11 +74,12 @@ End Function
 
 
 
 
 '*** displays modified (dirties) objects
 '*** displays modified (dirties) objects
-Public Function list_modified(acType As Integer)
-' returns a list (string with ';' separator) of the objects wich were updated since last export
+Public Function list_to_export(acType As Integer)
+' returns a list (string with ';' separator) of the objects wich will be exported
+
     Dim sources_date As Date
     Dim sources_date As Date
     
     
-    list_modified = ""
+    list_to_export = ""
     
     
     sources_date = get_sources_date()
     sources_date = get_sources_date()
     
     
@@ -79,11 +94,12 @@ Public Function list_modified(acType As Integer)
         If Left$(rs![name], 4) <> "MSys" And _
         If Left$(rs![name], 4) <> "MSys" And _
             Left$(rs![name], 1) <> "~" Then
             Left$(rs![name], 1) <> "~" Then
             
             
-            If get_last_update_date(acType, rs![name]) > sources_date Then
-                If Len(list_modified) > 0 Then
-                    list_modified = list_modified & ";" & rs![name]
+            If get_last_update_date(acType, rs![name]) > sources_date Or _
+                Not files_exist_for(acType, rs![name]) Then
+                If Len(list_to_export) > 0 Then
+                    list_to_export = list_to_export & ";" & rs![name]
                 Else
                 Else
-                    list_modified = rs![name]
+                    list_to_export = rs![name]
                 End If
                 End If
             End If
             End If
             
             
@@ -95,12 +111,12 @@ Public Function list_modified(acType As Integer)
 emptylist:
 emptylist:
 End Function
 End Function
 
 
-Public Function msg_list_modified() As String
+Public Function msg_list_to_export() As String
 'returns a formatted text listing all of the objects which were updated since last export of the sources
 'returns a formatted text listing all of the objects which were updated since last export of the sources
     Dim lstmod, obj_type_split, obj_type_label, obj_type_num As String
     Dim lstmod, obj_type_split, obj_type_label, obj_type_num As String
     Dim obj_type, objname As Variant
     Dim obj_type, objname As Variant
     
     
-    msg_list_modified = ""
+    msg_list_to_export = ""
 
 
     For Each obj_type In Split( _
     For Each obj_type In Split( _
         "tables|" & acTable & "," & _
         "tables|" & acTable & "," & _
@@ -115,13 +131,15 @@ Public Function msg_list_modified() As String
         obj_type_label = obj_type_split(0)
         obj_type_label = obj_type_split(0)
         obj_type_num = obj_type_split(1)
         obj_type_num = obj_type_split(1)
 
 
-        lstmod = list_modified(CInt(obj_type_num))
+        lstmod = list_to_export(CInt(obj_type_num))
         
         
         If Len(lstmod) > 0 Then
         If Len(lstmod) > 0 Then
-            msg_list_modified = msg_list_modified & "** " & UCase(obj_type_label) & " **" & vbNewLine
+            msg_list_to_export = msg_list_to_export & "> " & UCase(obj_type_label) & ":" & vbNewLine
             For Each objname In Split(lstmod, ";")
             For Each objname In Split(lstmod, ";")
-                msg_list_modified = msg_list_modified & "   - " & objname & vbNewLine
+                msg_list_to_export = msg_list_to_export & objname
+                msg_list_to_export = msg_list_to_export & ", "
             Next objname
             Next objname
+            msg_list_to_export = Left(msg_list_to_export, Len(msg_list_to_export) - 2) & vbNewLine & vbNewLine
         End If
         End If
     Next obj_type
     Next obj_type
 
 
@@ -166,7 +184,7 @@ Public Function CleanDirs(Optional ByVal sim As Boolean = False)
     Dim obj_type_num As Integer
     Dim obj_type_num As Integer
     
     
     Dim oFSO As Scripting.FileSystemObject
     Dim oFSO As Scripting.FileSystemObject
-    Dim oFld As Scripting.folder
+    Dim oFld As Scripting.Folder
     Dim file As Scripting.file
     Dim file As Scripting.file
     'Instanciation du FSO
     'Instanciation du FSO
     Set oFSO = New Scripting.FileSystemObject
     Set oFSO = New Scripting.FileSystemObject
@@ -194,7 +212,7 @@ Public Function CleanDirs(Optional ByVal sim As Boolean = False)
             If rsSys.NoMatch Then
             If rsSys.NoMatch Then
                 'object doesn't exist anymore
                 'object doesn't exist anymore
                 If Len(CleanDirs) > 0 Then CleanDirs = CleanDirs & "|"
                 If Len(CleanDirs) > 0 Then CleanDirs = CleanDirs & "|"
-                CleanDirs = CleanDirs & (Replace(file.Path, CurrentProject.Path, "."))
+                CleanDirs = CleanDirs & (Replace(file.path, CurrentProject.path, "."))
                 If Not sim Then
                 If Not sim Then
                     oFSO.DeleteFile file
                     oFSO.DeleteFile file
                 End If
                 End If
@@ -205,4 +223,40 @@ next_obj_type:
     Next obj_type
     Next obj_type
 
 
 
 
+End Function
+
+Public Function files_exist_for(acType As Integer, name As String) As Boolean
+'does the object has its files in sources
+    Dim source_path As String
+    source_path = VCS_Dir.ProjectPath() & "source\"
+    
+    Select Case acType
+        Case acForm
+            files_exist_for = (dir(source_path & "forms\" & name & ".bas") <> "")
+            
+        Case acReport
+            files_exist_for = (dir(source_path & "reports\" & name & ".bas") <> "" _
+                               And _
+                               dir(source_path & "reports\" & name & ".pv") <> "")
+    
+        Case acQuery
+            files_exist_for = (dir(source_path & "queries\" & name & ".bas") <> "")
+        
+        Case acTable
+            
+            files_exist_for = ( _
+                                 dir(source_path & "tbldef\" & name & ".sql") <> "" _
+                                 Or _
+                                 dir(source_path & "tbldef\" & name & ".lnkd") <> "" _
+                               )
+        
+        Case acMacro
+            files_exist_for = (dir(source_path & "macros\" & name & ".bas") <> "")
+        
+        Case acModule
+            files_exist_for = (dir(source_path & "modules\" & name & ".bas") <> "")
+    
+    End Select
+
+
 End Function
 End Function

+ 2 - 3
source/modules/VCS_Reference.bas

@@ -51,8 +51,7 @@ failed_guid:
         'The reference is already present in the access project - so we can ignore the error
         'The reference is already present in the access project - so we can ignore the error
         Resume Next
         Resume Next
     Else
     Else
-        MsgBox "Failed to register " & GUID, , "Error: " & err.number
-        'Do we really want to carry on the import with missing references??? - Surely this is fatal
+        logger "ImportReferences", "ERROR", "Failed to register " & GUID
         Resume go_on
         Resume go_on
     End If
     End If
     
     
@@ -66,7 +65,7 @@ Public Sub ExportReferences(ByVal obj_path As String)
     Dim ref As Reference
     Dim ref As Reference
 
 
     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(obj_path & "references.csv", overwrite:=True, unicode:=False)
     For Each ref In Application.References
     For Each ref In Application.References
         If ref.GUID <> vbNullString Then ' references of types mdb,accdb,mde etc don't have a GUID
         If ref.GUID <> vbNullString Then ' references of types mdb,accdb,mde etc don't have a GUID
             If Not ref.BuiltIn Then
             If Not ref.BuiltIn Then

+ 5 - 5
source/modules/VCS_Relation.bas

@@ -4,11 +4,11 @@ Option Private Module
 Option Explicit
 Option Explicit
 
 
 
 
-Public Sub ExportRelation(ByVal rel As DAO.Relation, ByVal filePath As String)
+Public Sub ExportRelation(ByVal rel As DAO.Relation, ByVal filepath As String)
     Dim fso As Object
     Dim fso As Object
     Dim OutFile As Object
     Dim OutFile As Object
     Set fso = CreateObject("Scripting.FileSystemObject")
     Set fso = CreateObject("Scripting.FileSystemObject")
-    Set OutFile = fso.CreateTextFile(filePath, overwrite:=True, Unicode:=False)
+    Set OutFile = fso.CreateTextFile(filepath, overwrite:=True, unicode:=False)
 
 
     OutFile.WriteLine rel.Attributes 'RelationAttributeEnum
     OutFile.WriteLine rel.Attributes 'RelationAttributeEnum
     OutFile.WriteLine rel.name
     OutFile.WriteLine rel.name
@@ -27,11 +27,11 @@ Public Sub ExportRelation(ByVal rel As DAO.Relation, ByVal filePath As String)
 
 
 End Sub
 End Sub
 
 
-Public Sub ImportRelation(ByVal filePath As String)
+Public Sub ImportRelation(ByVal filepath As String)
     Dim fso As Object
     Dim fso As Object
     Dim InFile As Object
     Dim InFile As Object
     Set fso = CreateObject("Scripting.FileSystemObject")
     Set fso = CreateObject("Scripting.FileSystemObject")
-    Set InFile = fso.OpenTextFile(filePath, iomode:=ForReading, create:=False, Format:=TristateFalse)
+    Set InFile = fso.OpenTextFile(filepath, iomode:=ForReading, create:=False, Format:=TristateFalse)
     Dim rel As DAO.Relation
     Dim rel As DAO.Relation
     Set rel = New DAO.Relation
     Set rel = New DAO.Relation
     
     
@@ -48,7 +48,7 @@ Public Sub ImportRelation(ByVal filePath As String)
             f.ForeignName = InFile.readline
             f.ForeignName = InFile.readline
             If "End" <> InFile.readline Then
             If "End" <> InFile.readline Then
                 Set f = Nothing
                 Set f = Nothing
-                err.Raise 40000, "ImportRelation", "Missing 'End' for a 'Begin' in " & filePath
+                err.Raise 40000, "ImportRelation", "Missing 'End' for a 'Begin' in " & filepath
             End If
             End If
             rel.Fields.Append f
             rel.Fields.Append f
         End If
         End If

+ 9 - 5
source/modules/VCS_Report.bas

@@ -42,7 +42,7 @@ End Type
 
 
 
 
 'Exports print vars for reports
 'Exports print vars for reports
-Public Sub ExportPrintVars(ByVal obj_name As String, ByVal filePath As String)
+Public Sub ExportPrintVars(ByVal obj_name As String, ByVal filepath As String)
   DoEvents
   DoEvents
   Dim fso As Object
   Dim fso As Object
   Set fso = CreateObject("Scripting.FileSystemObject")
   Set fso = CreateObject("Scripting.FileSystemObject")
@@ -57,6 +57,7 @@ Public Sub ExportPrintVars(ByVal obj_name As String, ByVal filePath As String)
    DoCmd.SetWarnings False
    DoCmd.SetWarnings False
    DoCmd.OpenReport obj_name, acViewDesign, , , acHidden
    DoCmd.OpenReport obj_name, acViewDesign, , , acHidden
    DoCmd.SetWarnings True
    DoCmd.SetWarnings True
+   
    Set rpt = Reports(obj_name)
    Set rpt = Reports(obj_name)
   
   
   
   
@@ -73,7 +74,7 @@ Public Sub ExportPrintVars(ByVal obj_name As String, ByVal filePath As String)
   End If
   End If
   
   
   Dim OutFile As Object
   Dim OutFile As Object
-  Set OutFile = fso.CreateTextFile(filePath, overwrite:=True, Unicode:=False)
+  Set OutFile = fso.CreateTextFile(filepath, overwrite:=True, unicode:=False)
   
   
   'print out print var values
   'print out print var values
   OutFile.WriteLine DM.intOrientation
   OutFile.WriteLine DM.intOrientation
@@ -88,8 +89,8 @@ Public Sub ExportPrintVars(ByVal obj_name As String, ByVal filePath As String)
   DoCmd.Close acReport, obj_name, acSaveYes
   DoCmd.Close acReport, obj_name, acSaveYes
 End Sub
 End Sub
 
 
-Public Sub ImportPrintVars(ByVal obj_name As String, ByVal filePath As String)
-  
+Public Sub ImportPrintVars(ByVal obj_name As String, ByVal filepath As String)
+  On err GoTo err
   Dim fso As Object
   Dim fso As Object
   Set fso = CreateObject("Scripting.FileSystemObject")
   Set fso = CreateObject("Scripting.FileSystemObject")
   
   
@@ -118,7 +119,7 @@ Public Sub ImportPrintVars(ByVal obj_name As String, ByVal filePath As String)
   End If
   End If
   
   
   Dim InFile As Object
   Dim InFile As Object
-  Set InFile = fso.OpenTextFile(filePath, iomode:=ForReading, create:=False, Format:=TristateFalse)
+  Set InFile = fso.OpenTextFile(filepath, iomode:=ForReading, create:=False, Format:=TristateFalse)
   
   
   'print out print var values
   'print out print var values
   DM.intOrientation = InFile.readline
   DM.intOrientation = InFile.readline
@@ -136,4 +137,7 @@ Public Sub ImportPrintVars(ByVal obj_name As String, ByVal filePath As String)
   Set rpt = Nothing
   Set rpt = Nothing
   
   
   DoCmd.Close acReport, obj_name, acSaveYes
   DoCmd.Close acReport, obj_name, acSaveYes
+Exit Sub
+err:
+    logger "ImportPrintVars", "ERROR", "Report " & obj_name & " was not found, import print vars cancelled"
 End Sub
 End Sub

+ 1 - 1
source/modules/VCS_ShellUtilities.bas

@@ -75,6 +75,6 @@ End Sub
 
 
 Public Function cmd(ByVal command As String, Optional WindowStyle As Long = vbHide, Optional in_dir As String = "")
 Public Function cmd(ByVal command As String, Optional WindowStyle As Long = vbHide, Optional in_dir As String = "")
 ' runs a comand with windows command line
 ' runs a comand with windows command line
-    If Len(in_dir) = 0 Then in_dir = CurrentProject.Path
+    If Len(in_dir) = 0 Then in_dir = CurrentProject.path
     Call ShellWait("cmd.exe /r cd " & in_dir & " & " & command, WindowStyle)
     Call ShellWait("cmd.exe /r cd " & in_dir & " & " & command, WindowStyle)
 End Function
 End Function

+ 39 - 20
source/modules/VCS_Table.bas

@@ -35,15 +35,15 @@ Public Sub ExportLinkedTable(ByVal tbl_name As String, ByVal obj_path As String)
     ' 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
     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
     OutFile.Write vbCrLf
     OutFile.Write vbCrLf
     
     
-    If InStr(1, CurrentDb.TableDefs(tbl_name).connect, "DATABASE=" & CurrentProject.Path) Then
+    If InStr(1, CurrentDb.TableDefs(tbl_name).connect, "DATABASE=" & CurrentProject.path) Then
         'change to relatave path
         'change to relatave path
         Dim connect() As String
         Dim connect() As String
-        connect = Split(CurrentDb.TableDefs(tbl_name).connect, CurrentProject.Path)
+        connect = Split(CurrentDb.TableDefs(tbl_name).connect, CurrentProject.path)
         OutFile.Write connect(0) & "." & connect(1)
         OutFile.Write connect(0) & "." & connect(1)
     Else
     Else
         OutFile.Write CurrentDb.TableDefs(tbl_name).connect
         OutFile.Write CurrentDb.TableDefs(tbl_name).connect
@@ -71,13 +71,14 @@ Err_LinkedTable_Fin:
     On Error Resume Next
     On Error Resume Next
     OutFile.Close
     OutFile.Close
     'save files as .odbc
     'save files as .odbc
-    VCS_File.ConvertUcs2Utf8 tempFilePath, obj_path & tbl_name & ".LNKD"
+    VCS_File.ConvertUcs2Utf8 tempFilePath, obj_path & VCS_IE_Functions.to_filename(tbl_name) & ".LNKD"
     
     
     Exit Sub
     Exit Sub
     
     
 Err_LinkedTable:
 Err_LinkedTable:
     OutFile.Close
     OutFile.Close
-    MsgBox err.Description, vbCritical, "ERROR: EXPORT LINKED TABLE"
+    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")
     Resume Err_LinkedTable_Fin
     Resume Err_LinkedTable_Fin
 End Sub
 End Sub
 
 
@@ -120,8 +121,10 @@ Public Sub ExportTableDef(Db As DAO.Database, td As DAO.TableDef, ByVal tableNam
     Dim ff As Object
     Dim ff As Object
     'Debug.Print tableName
     'Debug.Print tableName
     Set fso = CreateObject("Scripting.FileSystemObject")
     Set fso = CreateObject("Scripting.FileSystemObject")
-    Set OutFile = fso.CreateTextFile(filename, overwrite:=True, Unicode:=False)
+    Set OutFile = fso.CreateTextFile(filename, overwrite:=True, unicode:=False)
+    
     sql = "CREATE TABLE " & strName(tableName) & " (" & vbCrLf
     sql = "CREATE TABLE " & strName(tableName) & " (" & vbCrLf
+    
     For Each fi In td.Fields
     For Each fi In td.Fields
         sql = sql & "  " & strName(fi.name) & " "
         sql = sql & "  " & strName(fi.name) & " "
         If (fi.Attributes And dbAutoIncrField) Then
         If (fi.Attributes And dbAutoIncrField) Then
@@ -382,7 +385,7 @@ Public Sub ExportTableData(ByVal tbl_name As String, ByVal obj_path As String)
     Dim tempFileName As String
     Dim tempFileName As String
     tempFileName = VCS_File.TempFile()
     tempFileName = VCS_File.TempFile()
 
 
-    Set OutFile = fso.CreateTextFile(tempFileName, overwrite:=True, Unicode:=True)
+    Set OutFile = fso.CreateTextFile(tempFileName, overwrite:=True, unicode:=True)
 
 
     c = 0
     c = 0
     For Each fieldObj In rs.Fields
     For Each fieldObj In rs.Fields
@@ -417,7 +420,7 @@ Public Sub ExportTableData(ByVal tbl_name As String, ByVal obj_path As String)
     rs.Close
     rs.Close
     OutFile.Close
     OutFile.Close
 
 
-    VCS_File.ConvertUcs2Utf8 tempFileName, obj_path & tbl_name & ".txt"
+    VCS_File.ConvertUcs2Utf8 tempFileName, obj_path & VCS_IE_Functions.to_filename(tbl_name) & ".txt"
     fso.DeleteFile tempFileName
     fso.DeleteFile tempFileName
 End Sub
 End Sub
 
 
@@ -440,6 +443,7 @@ Public Sub ImportLinkedTable(ByVal tblName As String, ByRef obj_path As String)
     tempFilePath = VCS_File.TempFile()
     tempFilePath = VCS_File.TempFile()
     
     
     ConvertUtf8Ucs2 obj_path & tblName & ".LNKD", tempFilePath
     ConvertUtf8Ucs2 obj_path & tblName & ".LNKD", tempFilePath
+    
     ' open file for reading with Create=False, Unicode=True (USC-2 Little Endian format)
     ' open file for reading with Create=False, Unicode=True (USC-2 Little Endian format)
     Set InFile = fso.OpenTextFile(tempFilePath, iomode:=ForReading, create:=False, Format:=TristateTrue)
     Set InFile = fso.OpenTextFile(tempFilePath, iomode:=ForReading, create:=False, Format:=TristateTrue)
     
     
@@ -461,7 +465,7 @@ err_notable_fin:
     Dim connect As String
     Dim connect As String
     connect = InFile.readline()
     connect = InFile.readline()
     If InStr(1, connect, "DATABASE=.\") Then 'replace relative path with literal path
     If InStr(1, connect, "DATABASE=.\") Then 'replace relative path with literal path
-        connect = Replace(connect, "DATABASE=.\", "DATABASE=" & CurrentProject.Path & "\")
+        connect = Replace(connect, "DATABASE=.\", "DATABASE=" & CurrentProject.path & "\")
     End If
     End If
     td.connect = connect
     td.connect = connect
     
     
@@ -471,7 +475,8 @@ err_notable_fin:
     GoTo Err_CreateLinkedTable_Fin
     GoTo Err_CreateLinkedTable_Fin
     
     
 Err_CreateLinkedTable:
 Err_CreateLinkedTable:
-    MsgBox err.Description, vbCritical, "ERROR: IMPORT LINKED TABLE"
+    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")
     Resume Err_CreateLinkedTable_Fin
     Resume Err_CreateLinkedTable_Fin
     
     
 Err_CreateLinkedTable_Fin:
 Err_CreateLinkedTable_Fin:
@@ -502,8 +507,8 @@ End Sub
 
 
 ' Import Table Definition
 ' Import Table Definition
 Public Sub ImportTableDef(ByVal tblName As String, ByVal directory As String)
 Public Sub ImportTableDef(ByVal tblName As String, ByVal directory As String)
-    Dim filePath As String
-    filePath = directory & tblName & ".sql"
+    Dim filepath As String
+    filepath = directory & tblName & ".sql"
     Dim Db As Object ' DAO.Database
     Dim Db As Object ' DAO.Database
     Dim fso As Object
     Dim fso As Object
     Dim InFile As Object
     Dim InFile As Object
@@ -520,18 +525,20 @@ Public Sub ImportTableDef(ByVal tblName As String, ByVal directory As String)
 
 
     n = -1
     n = -1
     Set fso = CreateObject("Scripting.FileSystemObject")
     Set fso = CreateObject("Scripting.FileSystemObject")
-    VCS_File.ConvertUtf8Ucs2 filePath, tempFileName
+
+    VCS_File.ConvertUtf8Ucs2 filepath, tempFileName
+    
     ' open file for reading with Create=False, Unicode=True (USC-2 Little Endian format)
     ' open file for reading with Create=False, Unicode=True (USC-2 Little Endian format)
-    Set InFile = fso.OpenTextFile(tempFileName, iomode:=ForReading, create:=False, Format:=TristateTrue)
+    'Set InFile = fso.OpenTextFile(tempFileName, iomode:=ForReading, create:=False, Format:=TristateTrue)
     Set Db = CurrentDb
     Set Db = CurrentDb
+    
     KillTable tblName, Db
     KillTable tblName, Db
-    buf = InFile.readline()
-    Do Until InFile.AtEndOfStream
-        buf = buf & InFile.readline()
-    Loop
+
+    buf = ReadFile(filepath, "x-ansi")
     
     
     ' The following block is needed because "on update" actions may cause problems
     ' The following block is needed because "on update" actions may cause problems
     For Each s In Split("UPDATE|DELETE", "|")
     For Each s In Split("UPDATE|DELETE", "|")
+    
       p = InStr(buf, "ON " & s & " CASCADE")
       p = InStr(buf, "ON " & s & " CASCADE")
       Do While p > 0
       Do While p > 0
           n = n + 1
           n = n + 1
@@ -555,7 +562,9 @@ Public Sub ImportTableDef(ByVal tblName As String, ByVal directory As String)
           p = InStr(p, "ON " & s & " CASCADE", buf)
           p = InStr(p, "ON " & s & " CASCADE", buf)
       Loop
       Loop
     Next
     Next
+    
     On Error Resume Next
     On Error Resume Next
+    
     For i = 0 To n
     For i = 0 To n
         strMsg = k(i).table & " to " & k(i).foreignTable
         strMsg = k(i).table & " to " & k(i).foreignTable
         strMsg = strMsg & "(  "
         strMsg = strMsg & "(  "
@@ -573,10 +582,15 @@ Public Sub ImportTableDef(ByVal tblName As String, ByVal directory As String)
             strMsg = strMsg & " on delete cascade " & vbCrLf
             strMsg = strMsg & " on delete cascade " & vbCrLf
         End If
         End If
     Next
     Next
+    
     On Error GoTo 0
     On Error GoTo 0
     Db.execute buf
     Db.execute buf
-    InFile.Close
-    If Len(strMsg) > 0 Then MsgBox strMsg, vbOKOnly, "Correct manually"
+    'InFile.Close
+    
+    If Len(strMsg) > 0 Then
+        MsgBox strMsg, vbOKOnly, "Correct manually"
+        logger "ImportTableDef", "ERROR", strMsg & " - Correct manually"
+    End If
         
         
 End Sub
 End Sub
 
 
@@ -593,7 +607,9 @@ Public Sub ImportTableData(ByVal tblName As String, ByVal obj_path As String)
     
     
     Dim tempFileName As String
     Dim tempFileName As String
     tempFileName = VCS_File.TempFile()
     tempFileName = VCS_File.TempFile()
+    
     VCS_File.ConvertUtf8Ucs2 obj_path & tblName & ".txt", tempFileName
     VCS_File.ConvertUtf8Ucs2 obj_path & tblName & ".txt", tempFileName
+    
     ' open file for reading with Create=False, Unicode=True (USC-2 Little Endian format)
     ' open file for reading with Create=False, Unicode=True (USC-2 Little Endian format)
     Set InFile = fso.OpenTextFile(tempFileName, iomode:=ForReading, create:=False, Format:=TristateTrue)
     Set InFile = fso.OpenTextFile(tempFileName, iomode:=ForReading, create:=False, Format:=TristateTrue)
     Set Db = CurrentDb
     Set Db = CurrentDb
@@ -617,6 +633,9 @@ Public Sub ImportTableData(ByVal tblName As String, ByVal obj_path As String)
                     value = Replace(value, "\n", vbCrLf)
                     value = Replace(value, "\n", vbCrLf)
                     value = Replace(value, "\\", "\")
                     value = Replace(value, "\\", "\")
                 End If
                 End If
+                '** correct a bug due to internationalization
+                If fieldObj.Type = dbBoolean Then value = CBool(value)
+                '**
                 rs(fieldObj.name) = value
                 rs(fieldObj.name) = value
                 c = c + 1
                 c = c + 1
             Next
             Next

+ 3 - 2
source/modules/VCS_Utilities.bas

@@ -44,7 +44,8 @@ End Function
 
 
 Public Function msys_type_filter(acType) As String
 Public Function msys_type_filter(acType) As String
 'returns a sql filter string for the object type
 'returns a sql filter string for the object type
-'NB: types in msysobjects table
+'NB: do not return system tables
+'NB2: here are the types in msysobjects table:
 '-32768 = Form
 '-32768 = Form
 '-32766 = Macro
 '-32766 = Macro
 '-32764 = Report
 '-32764 = Report
@@ -62,7 +63,7 @@ Public Function msys_type_filter(acType) As String
 
 
     Select Case acType
     Select Case acType
         Case acTable
         Case acTable
-            msys_type_filter = "([Type]=1 or [Type]=4 or [Type]=6)"
+            msys_type_filter = "(([Type]=1 or [Type]=4 or [Type]=6) AND ([name] Not Like 'MSys*' AND [name] Not Like 'f_*_Data'))"
         Case acQuery
         Case acQuery
             msys_type_filter = "[Type]=5"
             msys_type_filter = "[Type]=5"
         Case acForm
         Case acForm

+ 1 - 1
source/tables/ztbl_vcs.txt

@@ -1,3 +1,3 @@
 key	val
 key	val
 include_tables	ztbl_vcs,tbl_commands
 include_tables	ztbl_vcs,tbl_commands
-sources_date	17/10/2016 18:10:20
+sources_date	03/11/2016 17:03:20

+ 7 - 0
source/tbldef/vcs_log.sql

@@ -0,0 +1,7 @@
+CREATE TABLE [vcs_log] (
+  [command] VARCHAR (255),
+  [dt] VARCHAR (255),
+  [origin] VARCHAR (255),
+  [level] VARCHAR (255),
+  [msg] VARCHAR (255)
+)

BIN
vcs.zip