premier commit

CHANGELOG.md

@@ -0,0 +1,150 @@
+Change log
+==========
+Version 1.0.0 - 11 Mar 2015
+----------------------------
+jwbrookes:
+* Added support for Table Data Macros
+* Added support for Linked Tables (supports relative paths for linked files)
+* Added support for Print Variables in Reports (Page size and orientation) 
+* Added support for Relation for all types of table
+* LoadVCS warnings removed when no object delete is required
+* Removed elements from Report export that change constantly but don't affect import
+* Fixed query import bug (complex queries being rearranged on import)
+* Fixed missing constraints in table export
+
+prmills:
+* Added support for bit fields in table Import/Export
+* Added support for References without GUIDs
+* Export all table data with `INCLUDE_TABLES = "*"`
+
+Version 0.12.0 - 28 Jan 2015
+----------------------------
+jwbrookes:
+* Refactored AppCodeImportExport into several modules
+* Added VCS_Loader, a module to import multiple vba modules into a database 
+
+
+Version 0.11.1 - 14 Jan 2015
+---------------------------
+jwbrookes:
+* Fixed bug in ExportTableDef function
+* Removed redundant DeleteFile function (had been left commented out in the module)
+
+
+Version 0.11 - 01 May 2014
+-------------------------
+matonb:
+* Removed DeleteFile function and replaced calls to Kill with FileSystemObject.DeleteFile
+
+
+Version 0.10 - 09 Mar 2014
+-------------------------
+matonb:
+* Added DoEvents in loops to avoid "Unresponsive" state.
+
+
+Version 0.9 - 15 Feb 2014
+-------------------------
+matonb:
+*  Aggressive Sanitise, moved BaseInfo from "Block" regex to Line level.
+*  Changed line level skipping to include lines with deeper indendation the follow.
+  This catches split lines mostly found in BaseInfo exports.
+
+
+Version 0.8 - 14 Feb 2014
+-------------------------
+matonb:
+*  Aggressive Sanitise now excludes "BaseInfo" lines.
+  These lines were seen to be randomly switching between being empty,
+  not present or containing SQL on an arbitary basis.
+
+
+Version 0.7 - 06 Jul 2013
+-------------------------
+matonb:
+*  Replaced TempFile function.
+*  Temporary file names now generated via external MS libraries.
+*  Functions using TempFile updated to only call TempFile function once.
+   *  Temporary file path and name stored in tmepFileName variable.
+   *  Temporary files deleted when done.
+*  Changed db declaration in ImportProject to DAO.database.
+
+
+Version 0.6 - 06 Jul 2013
+-------------------------
+
+matonb:
+
+*  AppcodeImportExport excluded from ExportAllSource
+*  Added ImportProject sub-routine,  
+   Deletes all forms, macros, modules and queries before calling ImportAllSource.  
+   By clearing out the existing objects, you know that your database only contains  
+   code from your version control database.  
+   Excludes *AppCodeImportExport*
+
+Version 0.5 - 29 May 2013
+--------------------------
+
+matonb:
+
+*  All "exclusion" patterns are now matched by regex.
+*  Added StripPublishOption constant.  
+   If set to _True_ the following lines are also excluded from the export files
+  * dbByte "PublishToWeb" ="1"
+  * PublishOption =1
+*  Added DeleteFile(FileName) function  
+   The function tries to delete _FileName_ three (3) times before giving up.  
+   A delay of 100ms is introduced between delete attempts should the first fail.
+
+Version 0.4 - 19 Apr 2013
+--------------------------
+
+matonb:
+
+*  Added dbLongBinary "DOL" to aggressive sanitize, these statements were
+   appearing in queries and being flagged by git as modified in files that
+   hadn't been touched by developers.
+
+Version 0.3.2 - 8 Apr 2013
+--------------------------
+
+matonb:
+* 0.3.1 Patched - Serious Problem:  SanitizeTextFiles If logic removed all
+        lines containing "Begin".
+* 0.3.2 Replaced if block for skipping code sections in SanitizeTextFiles with
+        regular expression.
+
+Version 0.3 - 6 Apr 2013
+------------------------
+
+bkidwell:
+* Sanitize query exports.
+* Fixed SERIOUS TYPO in UCS2-to-UTF-8 conversion (wrong threshold for 2 byte versus 3 byte symbol in output stream).
+* AggressiveSanitize default True.
+
+matonb:
+* Added AggressiveSanitize constant, it's a number to allow for different levels in the future. ~~Default False.~~
+* Added Skipping for GUID & Namemap in aggressive sanitize mode.
+* ~~If AggressiveSanitize is on, also sanitize query exports.~~
+* Append Number of objects imported/exported to information lines in immediate window.
+* Updated readme (removed references to terminal window).
+* Close all open forms and reports when importing and exporting because you can't import an open form or report.
+
+Version 0.2 - 4 Apr 2013
+------------------------
+
+matonb:
+* Added dbLongBinary "DOL" to SkipList in SanitizeTextFiles.
+* Added Source directory check to ImportAllSource, pops up a message box if missing.
+* Only create source directories if there is something to export.
+
+bkidwell:
+* Removed external executable for converting UCS-2-little-endian to and from UTF-8; replaced with VB6 methods.
+* Added demo database to the repository.
+* Removed the need for a special "export_[name]" query to export and import a lookup table.
+* Added check to determine if Queries, Forms, etc. are exported from THIS database (depending on which version of Access created it) uses UCS-2-little-endian, or a legacy 8-bit Windows character set. Skip converting to/from UTF-8 if not using UCS-2, because the point of the conversion was to avoid writing 0x00 bytes in the text files and confuse diff/merge tools.
+
+Version 0.1 - 22 Oct 2012
+-------------------------
+
+Initial release

LICENSE.txt

@@ -0,0 +1,16 @@
+Copyright © 2012 Brendan Kidwell et al
+
+Use of msaccess-vcs-integration and documentation are subject to the following
+BSD-style license:
+
+Permission to use, copy, modify, and/or distribute this software for any purpose
+with or without fee is hereby granted, provided that the above copyright notice
+and this permission notice appear in all copies.
+
+THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES WITH
+REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND
+FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY SPECIAL, DIRECT,
+INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM LOSS
+OF USE, DATA OR PROFITS, WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER
+TORTIOUS ACTION, ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF
+THIS SOFTWARE.

MSAccess-VCS/VCS_DataMacro.bas

@@ -0,0 +1,78 @@
+Attribute VB_Name = "VCS_DataMacro"
+Option Compare Database
+
+Option Private Module
+Option Explicit
+
+
+' For Access 2007 (VBA6) and earlier
+#If Not VBA7 Then
+  Private Const acTableDataMacro As Integer = 12
+#End If
+
+Public Sub ExportDataMacros(ByVal tableName As String, ByVal directory As String)
+    On Error GoTo Err_export
+    Dim filePath As String
+    
+    filePath = directory & tableName & ".xml"
+
+    VCS_IE_Functions.ExportObject acTableDataMacro, tableName, filePath, VCS_File.UsingUcs2
+    FormatDataMacro filePath
+
+    Exit Sub
+
+Err_export:
+    ' Error to export dataMacro, no contains dataMacro. Do nothing
+End Sub
+
+Public Sub ImportDataMacros(ByVal tableName As String, ByVal directory As String)
+    On Error GoTo Err_import
+    Dim filePath As String
+    
+    filePath = directory & tableName & ".xml"
+    VCS_IE_Functions.ImportObject acTableDataMacro, tableName, filePath, VCS_File.UsingUcs2
+    
+    Exit Sub
+    
+Err_import:
+    ' Error to import dataMacro. Do nothing
+End Sub
+
+'Splits exported DataMacro XML onto multiple lines
+'Allows git to find changes within lines using diff
+Private Sub FormatDataMacro(ByVal filePath As String)
+
+    Dim saveStream As Object 'ADODB.Stream
+
+    Set saveStream = CreateObject("ADODB.Stream")
+    saveStream.Charset = "utf-8"
+    saveStream.Type = 2 'adTypeText
+    saveStream.Open
+
+    Dim objStream As Object 'ADODB.Stream
+    Dim strData As String
+    Set objStream = CreateObject("ADODB.Stream")
+
+    objStream.Charset = "utf-8"
+    objStream.Type = 2 'adTypeText
+    objStream.Open
+    objStream.LoadFromFile (filePath)
+    
+    Do While Not objStream.EOS
+        strData = objStream.ReadText(-2) 'adReadLine
+
+        Dim tag As Variant
+        
+        For Each tag In Split(strData, ">")
+            If tag <> vbNullString Then
+                saveStream.WriteText tag & ">", 1 'adWriteLine
+            End If
+        Next
+        
+    Loop
+    
+    objStream.Close
+    saveStream.SaveToFile filePath, 2 'adSaveCreateOverWrite
+    saveStream.Close
+
+End Sub

MSAccess-VCS/VCS_Dir.bas

@@ -0,0 +1,60 @@
+Attribute VB_Name = "VCS_Dir"
+Option Compare Database
+
+Option Private Module
+Option Explicit
+
+
+' 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.
+Public Sub MkDirIfNotExist(ByVal Path As String)
+    On Error GoTo MkDirIfNotexist_noop
+    MkDir Path
+MkDirIfNotexist_noop:
+    On Error GoTo 0
+End Sub
+
+' Delete a file if it exists.
+Public Sub DelIfExist(ByVal Path As String)
+    On Error GoTo DelIfNotExist_Noop
+    Kill Path
+DelIfNotExist_Noop:
+    On Error GoTo 0
+End Sub
+
+' Erase all *.`ext` files in `Path`.
+Public Sub ClearTextFilesFromDir(ByVal Path As String, ByVal Ext As String)
+    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
+    On Error Resume Next
+    DirExists = False
+    DirExists = ((GetAttr(strPath) And vbDirectory) = vbDirectory)
+End Function
+
+Public Function FileExists(ByVal strPath As String) As Boolean
+    On Error Resume Next
+    FileExists = False
+    FileExists = ((GetAttr(strPath) And vbDirectory) <> vbDirectory)
+End Function

MSAccess-VCS/VCS_File.bas

@@ -0,0 +1,267 @@
+Attribute VB_Name = "VCS_File"
+Option Compare Database
+
+Option Private Module
+Option Explicit
+
+#If VBA7 Then
+  Private Declare PtrSafe _
+      Function getTempPath Lib "kernel32" _
+           Alias "GetTempPathA" (ByVal nBufferLength As Long, _
+                                 ByVal lpBuffer As String) As Long
+  Private Declare PtrSafe _
+      Function getTempFileName Lib "kernel32" _
+           Alias "GetTempFileNameA" (ByVal lpszPath As String, _
+                                     ByVal lpPrefixString As String, _
+                                     ByVal wUnique As Long, _
+                                     ByVal lpTempFileName As String) As Long
+#Else
+  Private Declare _
+      Function getTempPath Lib "kernel32" _
+           Alias "GetTempPathA" (ByVal nBufferLength As Long, _
+                                 ByVal lpBuffer As String) As Long
+  Private Declare _
+      Function getTempFileName Lib "kernel32" _
+           Alias "GetTempFileNameA" (ByVal lpszPath As String, _
+                                     ByVal lpPrefixString As String, _
+                                     ByVal wUnique As Long, _
+                                     ByVal lpTempFileName As String) As Long
+#End If
+
+' --------------------------------
+' Structures
+' --------------------------------
+
+' Structure to track buffered reading or writing of binary files
+Private Type BinFile
+    file_num As Integer
+    file_len As Long
+    file_pos As Long
+    buffer As String
+    buffer_len As Integer
+    buffer_pos As Integer
+    at_eof As Boolean
+    mode As String
+End Type
+
+
+' --------------------------------
+' Basic functions missing from VB 6: buffered file read/write, string builder, encoding check & conversion
+' --------------------------------
+
+' Open a binary file for reading (mode = 'r') or writing (mode = 'w').
+Private Function BinOpen(ByVal file_path As String, ByVal mode As String) As BinFile
+    Dim f As BinFile
+
+    f.file_num = FreeFile
+    f.mode = LCase$(mode)
+    If f.mode = "r" Then
+        Open file_path For Binary Access Read As f.file_num
+        f.file_len = LOF(f.file_num)
+        f.file_pos = 0
+        If f.file_len > &H4000 Then
+            f.buffer = String$(&H4000, " ")
+            f.buffer_len = &H4000
+        Else
+            f.buffer = String$(f.file_len, " ")
+            f.buffer_len = f.file_len
+        End If
+        f.buffer_pos = 0
+        Get f.file_num, f.file_pos + 1, f.buffer
+    Else
+        DelIfExist file_path
+        Open file_path For Binary Access Write As f.file_num
+        f.file_len = 0
+        f.file_pos = 0
+        f.buffer = String$(&H4000, " ")
+        f.buffer_len = 0
+        f.buffer_pos = 0
+    End If
+
+    BinOpen = f
+End Function
+
+' Buffered read one byte at a time from a binary file.
+Private Function BinRead(ByRef f As BinFile) As Integer
+    If f.at_eof = True Then
+        BinRead = 0
+        Exit Function
+    End If
+
+    BinRead = Asc(Mid$(f.buffer, f.buffer_pos + 1, 1))
+
+    f.buffer_pos = f.buffer_pos + 1
+    If f.buffer_pos >= f.buffer_len Then
+        f.file_pos = f.file_pos + &H4000
+        If f.file_pos >= f.file_len Then
+            f.at_eof = True
+            Exit Function
+        End If
+        If f.file_len - f.file_pos > &H4000 Then
+            f.buffer_len = &H4000
+        Else
+            f.buffer_len = f.file_len - f.file_pos
+            f.buffer = String$(f.buffer_len, " ")
+        End If
+        f.buffer_pos = 0
+        Get f.file_num, f.file_pos + 1, f.buffer
+    End If
+End Function
+
+' Buffered write one byte at a time from a binary file.
+Private Sub BinWrite(ByRef f As BinFile, b As Integer)
+    Mid(f.buffer, f.buffer_pos + 1, 1) = Chr$(b)
+    f.buffer_pos = f.buffer_pos + 1
+    If f.buffer_pos >= &H4000 Then
+        Put f.file_num, , f.buffer
+        f.buffer_pos = 0
+    End If
+End Sub
+
+' Close binary file.
+Private Sub BinClose(ByRef f As BinFile)
+    If f.mode = "w" And f.buffer_pos > 0 Then
+        f.buffer = Left$(f.buffer, f.buffer_pos)
+        Put f.file_num, , f.buffer
+    End If
+    Close f.file_num
+End Sub
+
+
+' Binary convert a UCS2-little-endian encoded file to UTF-8.
+Public Sub ConvertUcs2Utf8(ByVal Source As String, ByVal dest As String)
+    Dim f_in As BinFile
+    Dim f_out As BinFile
+    Dim in_low As Integer
+    Dim in_high As Integer
+
+    f_in = BinOpen(Source, "r")
+    f_out = BinOpen(dest, "w")
+
+    Do While Not f_in.at_eof
+        in_low = BinRead(f_in)
+        in_high = BinRead(f_in)
+        If in_high = 0 And in_low < &H80 Then
+            ' U+0000 - U+007F   0LLLLLLL
+            BinWrite f_out, in_low
+        ElseIf in_high < &H8 Then
+            ' U+0080 - U+07FF   110HHHLL 10LLLLLL
+            BinWrite f_out, &HC0 + ((in_high And &H7) * &H4) + ((in_low And &HC0) / &H40)
+            BinWrite f_out, &H80 + (in_low And &H3F)
+        Else
+            ' U+0800 - U+FFFF   1110HHHH 10HHHHLL 10LLLLLL
+            BinWrite f_out, &HE0 + ((in_high And &HF0) / &H10)
+            BinWrite f_out, &H80 + ((in_high And &HF) * &H4) + ((in_low And &HC0) / &H40)
+            BinWrite f_out, &H80 + (in_low And &H3F)
+        End If
+    Loop
+
+    BinClose f_in
+    BinClose f_out
+End Sub
+
+' Binary convert a UTF-8 encoded file to UCS2-little-endian.
+Public Sub ConvertUtf8Ucs2(ByVal Source As String, ByVal dest As String)
+    Dim f_in As BinFile
+    Dim f_out As BinFile
+    Dim in_1 As Integer
+    Dim in_2 As Integer
+    Dim in_3 As Integer
+
+    f_in = BinOpen(Source, "r")
+    f_out = BinOpen(dest, "w")
+
+    Do While Not f_in.at_eof
+        in_1 = BinRead(f_in)
+        If (in_1 And &H80) = 0 Then
+            ' U+0000 - U+007F   0LLLLLLL
+            BinWrite f_out, in_1
+            BinWrite f_out, 0
+        ElseIf (in_1 And &HE0) = &HC0 Then
+            ' U+0080 - U+07FF   110HHHLL 10LLLLLL
+            in_2 = BinRead(f_in)
+            BinWrite f_out, ((in_1 And &H3) * &H40) + (in_2 And &H3F)
+            BinWrite f_out, (in_1 And &H1C) / &H4
+        Else
+            ' U+0800 - U+FFFF   1110HHHH 10HHHHLL 10LLLLLL
+            in_2 = BinRead(f_in)
+            in_3 = BinRead(f_in)
+            BinWrite f_out, ((in_2 And &H3) * &H40) + (in_3 And &H3F)
+            BinWrite f_out, ((in_1 And &HF) * &H10) + ((in_2 And &H3C) / &H4)
+        End If
+    Loop
+
+    BinClose f_in
+    BinClose f_out
+End Sub
+
+' Determine if this database imports/exports code as UCS-2-LE. (Older file
+' formats cause exported objects to use a Windows 8-bit character set.)
+Public Function UsingUcs2() As Boolean
+    Dim obj_name As String
+    Dim obj_type As Variant
+    Dim fn As Integer
+    Dim bytes As String
+    Dim obj_type_split() As String
+    Dim obj_type_name As String
+    Dim obj_type_num As Integer
+    
+    If CurrentDb.QueryDefs.Count > 0 Then
+        obj_type_num = acQuery
+        obj_name = CurrentDb.QueryDefs(0).name
+    Else
+        For Each obj_type In Split( _
+            "Forms|" & acForm & "," & _
+            "Reports|" & acReport & "," & _
+            "Scripts|" & acMacro & "," & _
+            "Modules|" & acModule _
+        )
+            DoEvents
+            obj_type_split = Split(obj_type, "|")
+            obj_type_name = obj_type_split(0)
+            obj_type_num = Val(obj_type_split(1))
+            If CurrentDb.Containers(obj_type_name).Documents.Count > 0 Then
+                obj_name = CurrentDb.Containers(obj_type_name).Documents(0).name
+                Exit For
+            End If
+        Next
+    End If
+
+    If obj_name = vbNullString Then
+        ' No objects found that can be used to test UCS2 versus UTF-8
+        UsingUcs2 = True
+        Exit Function
+    End If
+
+    Dim tempFileName As String
+    tempFileName = VCS_File.TempFile()
+    
+    Application.SaveAsText obj_type_num, obj_name, tempFileName
+    fn = FreeFile
+    Open tempFileName For Binary Access Read As fn
+    bytes = "  "
+    Get fn, 1, bytes
+    If Asc(Mid$(bytes, 1, 1)) = &HFF And Asc(Mid$(bytes, 2, 1)) = &HFE Then
+        UsingUcs2 = True
+    Else
+        UsingUcs2 = False
+    End If
+    Close fn
+    
+    Dim FSO As Object
+    Set FSO = CreateObject("Scripting.FileSystemObject")
+    FSO.DeleteFile (tempFileName)
+End Function
+
+' Generate Random / Unique tempprary file name.
+Public Function TempFile(Optional ByVal sPrefix As String = "VBA") As String
+    Dim sTmpPath As String * 512
+    Dim sTmpName As String * 576
+    Dim nRet As Long
+    Dim sFileName As String
+    
+    nRet = getTempPath(512, sTmpPath)
+    nRet = getTempFileName(sTmpPath, sPrefix, 0, sTmpName)
+    If nRet <> 0 Then sFileName = Left$(sTmpName, InStr(sTmpName, vbNullChar) - 1)
+    TempFile = sFileName
+End Function

MSAccess-VCS/VCS_IE_Functions.bas

@@ -0,0 +1,181 @@
+Attribute VB_Name = "VCS_IE_Functions"
+Option Compare Database
+
+Option Private Module
+Option Explicit
+
+Private Const AggressiveSanitize As Boolean = True
+Private Const StripPublishOption As Boolean = True
+
+' Constants for Scripting.FileSystemObject API
+Public Const ForReading = 1, ForWriting = 2, ForAppending = 8
+Public Const TristateTrue = -1, TristateFalse = 0, TristateUseDefault = -2
+
+
+' 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)
+
+    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
+    Else
+        Application.SaveAsText obj_type_num, obj_name, file_path
+    End If
+End Sub
+
+' 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 Exit Sub
+    
+    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
+End Sub
+
+'shouldn't this be SanitizeTextFile (Singular)?
+
+' 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)
+    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)
+    
+        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 = "^" & 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)
+        fileName = Dir$()
+    Loop
+
+End Sub

MSAccess-VCS/VCS_ImportExport.bas

@@ -0,0 +1,595 @@
+Attribute VB_Name = "VCS_ImportExport"
+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 = ""
+' This is used in ImportAllSource
+Private Const DebugOutput As Boolean = False
+'this is used in ExportAllSource
+'Causes the VCS_ code to be exported
+Private Const ArchiveMyself As Boolean = False
+
+
+'returns true if named module is NOT part of the VCS code
+Private Function IsNotVCS(ByVal name As String) As Boolean
+    If name <> "VCS_ImportExport" And _
+      name <> "VCS_IE_Functions" And _
+      name <> "VCS_File" And _
+      name <> "VCS_Dir" And _
+      name <> "VCS_String" And _
+      name <> "VCS_Loader" And _
+      name <> "VCS_Table" And _
+      name <> "VCS_Reference" And _
+      name <> "VCS_DataMacro" And _
+      name <> "VCS_Report" And _
+      name <> "VCS_Relation" 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
+
+    Set Db = CurrentDb
+
+    CloseFormsReports
+    'InitUsingUcs2
+
+    source_path = VCS_Dir.ProjectPath() & "source\"
+    VCS_Dir.MkDirIfNotExist source_path
+
+    Debug.Print
+
+    obj_path = source_path & "queries\"
+    VCS_Dir.ClearTextFilesFromDir obj_path, "bas"
+    Debug.Print VCS_String.PadRight("Exporting queries...", 24);
+    obj_count = 0
+    For Each qry In Db.QueryDefs
+        DoEvents
+        If Left$(qry.name, 1) <> "~" Then
+            VCS_IE_Functions.ExportObject acQuery, qry.name, obj_path & qry.name & ".bas", VCS_File.UsingUcs2
+            obj_count = obj_count + 1
+        End If
+    Next
+    Debug.Print VCS_String.PadRight("Sanitizing...", 15);
+    VCS_IE_Functions.SanitizeTextFiles obj_path, "bas"
+    Debug.Print "[" & obj_count & "]"
+
+    
+    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
+        VCS_Dir.ClearTextFilesFromDir obj_path, "bas"
+        Debug.Print VCS_String.PadRight("Exporting " & obj_type_label & "...", 24);
+        For Each doc In Db.Containers(obj_type_name).Documents
+            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
+                VCS_IE_Functions.ExportObject obj_type_num, doc.name, obj_path & doc.name & ".bas", ucs2
+                
+                If obj_type_label = "reports" Then
+                    VCS_Report.ExportPrintVars doc.name, obj_path & doc.name & ".pv"
+                End If
+                
+                obj_count = obj_count + 1
+            End If
+        Next
+
+		Debug.Print VCS_String.PadRight("Sanitizing...", 15);
+        If obj_type_label <> "modules" Then
+            VCS_IE_Functions.SanitizeTextFiles obj_path, "bas"
+        End If
+        Debug.Print "[" & obj_count & "]"
+    Next
+    
+    VCS_Reference.ExportReferences source_path
+
+'-------------------------table export------------------------
+    obj_path = source_path & "tables\"
+    VCS_Dir.MkDirIfNotExist Left$(obj_path, InStrRev(obj_path, "\"))
+    VCS_Dir.ClearTextFilesFromDir obj_path, "txt"
+    
+    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, ",")
+    
+    Debug.Print VCS_String.PadRight("Exporting " & obj_type_label & "...", 24);
+    
+    For Each td In tds
+        ' 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
+                VCS_Table.ExportTableDef Db, td, td.name, obj_path
+                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
+                VCS_Table.ExportLinkedTable td.name, obj_path
+            End If
+            
+            obj_count = obj_count + 1
+            
+        End If
+    Next
+    Debug.Print "[" & obj_count & "]"
+    If obj_data_count > 0 Then
+      Debug.Print VCS_String.PadRight("Exported data...", 24) & "[" & obj_data_count & "]"
+    End If
+    
+    
+    Debug.Print VCS_String.PadRight("Exporting Relations...", 24);
+    obj_count = 0
+    obj_path = source_path & "relations\"
+    VCS_Dir.MkDirIfNotExist Left$(obj_path, InStrRev(obj_path, "\"))
+
+    VCS_Dir.ClearTextFilesFromDir obj_path, "txt"
+
+    Dim aRelation As DAO.Relation
+    
+    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 & aRelation.name & ".txt"
+            obj_count = obj_count + 1
+        End If
+    Next
+    Debug.Print "[" & obj_count & "]"
+    
+    Debug.Print "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
+
+    Set FSO = CreateObject("Scripting.FileSystemObject")
+
+    CloseFormsReports
+    'InitUsingUcs2
+
+    source_path = VCS_Dir.ProjectPath() & "source\"
+    If Not FSO.FolderExists(source_path) Then
+        MsgBox "No source found at:" & vbCrLf & source_path, vbExclamation, "Import failed"
+        Exit Sub
+    End If
+
+    Debug.Print
+    
+    If Not VCS_Reference.ImportReferences(source_path) Then
+        Debug.Print "Info: no references file in " & source_path
+        Debug.Print
+    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
+        Debug.Print VCS_String.PadRight("Importing queries...", 24);
+        obj_count = 0
+        Do Until Len(fileName) = 0
+            DoEvents
+            obj_name = Mid$(fileName, 1, InStrRev(fileName, ".") - 1)
+            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
+        Debug.Print "[" & obj_count & "]"
+    End If
+    
+    VCS_Dir.DelIfExist tempFilePath
+
+    ' restore table definitions
+    obj_path = source_path & "tbldef\"
+    fileName = Dir$(obj_path & "*.sql")
+    If Len(fileName) > 0 Then
+        Debug.Print VCS_String.PadRight("Importing tabledefs...", 24);
+        obj_count = 0
+        Do Until Len(fileName) = 0
+            obj_name = Mid$(fileName, 1, InStrRev(fileName, ".") - 1)
+            If DebugOutput Then
+                If obj_count = 0 Then
+                    Debug.Print
+                End If
+                Debug.Print "  [debug] table " & obj_name;
+                Debug.Print
+            End If
+            VCS_Table.ImportTableDef CStr(obj_name), obj_path
+            obj_count = obj_count + 1
+            fileName = Dir$()
+        Loop
+        Debug.Print "[" & obj_count & "]"
+    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
+        Debug.Print VCS_String.PadRight("Importing Linked tabledefs...", 24);
+        obj_count = 0
+        Do Until Len(fileName) = 0
+            obj_name = Mid$(fileName, 1, InStrRev(fileName, ".") - 1)
+            If DebugOutput Then
+                If obj_count = 0 Then
+                    Debug.Print
+                End If
+                Debug.Print "  [debug] table " & obj_name;
+                Debug.Print
+            End If
+            VCS_Table.ImportLinkedTable CStr(obj_name), obj_path
+            obj_count = obj_count + 1
+            fileName = Dir$()
+        Loop
+        Debug.Print "[" & obj_count & "]"
+    End If
+    
+    
+    
+    ' NOW we may load data
+    obj_path = source_path & "tables\"
+    fileName = Dir$(obj_path & "*.txt")
+    If Len(fileName) > 0 Then
+        Debug.Print VCS_String.PadRight("Importing tables...", 24);
+        obj_count = 0
+        Do Until Len(fileName) = 0
+            DoEvents
+            obj_name = Mid$(fileName, 1, InStrRev(fileName, ".") - 1)
+            VCS_Table.ImportTableData CStr(obj_name), obj_path
+            obj_count = obj_count + 1
+            fileName = Dir$()
+        Loop
+        Debug.Print "[" & obj_count & "]"
+    End If
+    
+    'load Data Macros - not DRY!
+    obj_path = source_path & "tbldef\"
+    fileName = Dir$(obj_path & "*.xml")
+    If Len(fileName) > 0 Then
+        Debug.Print VCS_String.PadRight("Importing Data Macros...", 24);
+        obj_count = 0
+        Do Until Len(fileName) = 0
+            DoEvents
+            obj_name = Mid$(fileName, 1, InStrRev(fileName, ".") - 1)
+            'VCS_Table.ImportTableData CStr(obj_name), obj_path
+            VCS_DataMacro.ImportDataMacros obj_name, obj_path
+            obj_count = obj_count + 1
+            fileName = Dir$()
+        Loop
+        Debug.Print "[" & obj_count & "]"
+    End If
+    
+
+        'import Data Macros
+    
+
+    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
+            Debug.Print VCS_String.PadRight("Importing " & obj_type_label & "...", 24);
+            obj_count = 0
+            Do Until Len(fileName) = 0
+                ' DoEvents no good idea!
+                obj_name = Mid$(fileName, 1, InStrRev(fileName, ".") - 1)
+                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
+                            MsgBox "Module " & obj_name & " could not be updated while running. Ensure latest version is included!", vbExclamation, "Warning"
+                    End If
+                End If
+                fileName = Dir$()
+            Loop
+            Debug.Print "[" & obj_count & "]"
+        
+        End If
+    Next
+    
+    'import Print Variables
+    Debug.Print VCS_String.PadRight("Importing Print Vars...", 24);
+    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)
+        VCS_Report.ImportPrintVars obj_name, obj_path & fileName
+        obj_count = obj_count + 1
+        fileName = Dir$()
+    Loop
+    Debug.Print "[" & obj_count & "]"
+    
+    'import relations
+    Debug.Print VCS_String.PadRight("Importing Relations...", 24);
+    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
+    Debug.Print "[" & obj_count & "]"
+    DoEvents
+    
+    Debug.Print "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 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
+    Do While Forms.Count > 0
+        DoCmd.Close acForm, Forms(0).name
+        DoEvents
+    Loop
+    Do While Reports.Count > 0
+        DoCmd.Close acReport, Reports(0).name
+        DoEvents
+    Loop
+    Exit Sub
+
+errorHandler:
+    Debug.Print "VCS_ImportExport.CloseFormsReports: Error #" & Err.Number & vbCrLf & _
+                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

MSAccess-VCS/VCS_Reference.bas

@@ -0,0 +1,83 @@
+Attribute VB_Name = "VCS_Reference"
+Option Compare Database
+
+Option Private Module
+Option Explicit
+
+
+' Import References from a CSV, true=SUCCESS
+Public Function ImportReferences(ByVal obj_path As String) As Boolean
+    Dim FSO As Object
+    Dim InFile As Object
+    Dim line As String
+    Dim item() As String
+    Dim GUID As String
+    Dim Major As Long
+    Dim Minor As Long
+    Dim fileName As String
+    Dim refName As String
+    
+    fileName = Dir$(obj_path & "references.csv")
+    If Len(fileName) = 0 Then
+        ImportReferences = False
+        Exit Function
+    End If
+    Set FSO = CreateObject("Scripting.FileSystemObject")
+    Set InFile = FSO.OpenTextFile(obj_path & fileName, iomode:=ForReading, create:=False, Format:=TristateFalse)
+    
+On Error GoTo failed_guid
+    Do Until InFile.AtEndOfStream
+        line = InFile.ReadLine
+        item = Split(line, ",")
+        If UBound(item) = 2 Then 'a ref with a guid
+          GUID = Trim$(item(0))
+          Major = CLng(item(1))
+          Minor = CLng(item(2))
+          Application.References.AddFromGuid GUID, Major, Minor
+        Else
+          refName = Trim$(item(0))
+          Application.References.AddFromFile refName
+        End If
+go_on:
+    Loop
+On Error GoTo 0
+    InFile.Close
+    Set InFile = Nothing
+    Set FSO = Nothing
+    ImportReferences = True
+    Exit Function
+    
+failed_guid:
+    If Err.Number = 32813 Then
+        'The reference is already present in the access project - so we can ignore the error
+        Resume Next
+    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
+        Resume go_on
+    End If
+    
+End Function
+
+' Export References to a CSV
+Public Sub ExportReferences(ByVal obj_path As String)
+    Dim FSO As Object
+    Dim OutFile As Object
+    Dim line As String
+    Dim ref As Reference
+
+    Set FSO = CreateObject("Scripting.FileSystemObject")
+    Set OutFile = FSO.CreateTextFile(obj_path & "references.csv", overwrite:=True, Unicode:=False)
+    For Each ref In Application.References
+        If ref.GUID <> vbNullString Then ' references of types mdb,accdb,mde etc don't have a GUID
+            If Not ref.BuiltIn Then
+                line = ref.GUID & "," & CStr(ref.Major) & "," & CStr(ref.Minor)
+                OutFile.WriteLine line
+            End If
+        Else
+            line = ref.FullPath
+            OutFile.WriteLine line
+        End If
+    Next
+    OutFile.Close
+End Sub

MSAccess-VCS/VCS_Relation.bas

@@ -0,0 +1,62 @@
+Attribute VB_Name = "VCS_Relation"
+Option Compare Database
+
+Option Private Module
+Option Explicit
+
+
+Public Sub ExportRelation(ByVal rel As DAO.Relation, ByVal filePath As String)
+    Dim FSO As Object
+    Dim OutFile As Object
+    Set FSO = CreateObject("Scripting.FileSystemObject")
+    Set OutFile = FSO.CreateTextFile(filePath, overwrite:=True, Unicode:=False)
+
+    OutFile.WriteLine rel.Attributes 'RelationAttributeEnum
+    OutFile.WriteLine rel.name
+    OutFile.WriteLine rel.table
+    OutFile.WriteLine rel.foreignTable
+    
+    Dim f As DAO.Field
+    For Each f In rel.Fields
+        OutFile.WriteLine "Field = Begin"
+        OutFile.WriteLine f.name
+        OutFile.WriteLine f.ForeignName
+        OutFile.WriteLine "End"
+    Next
+    
+    OutFile.Close
+
+End Sub
+
+Public Sub ImportRelation(ByVal filePath As String)
+    Dim FSO As Object
+    Dim InFile As Object
+    Set FSO = CreateObject("Scripting.FileSystemObject")
+    Set InFile = FSO.OpenTextFile(filePath, iomode:=ForReading, create:=False, Format:=TristateFalse)
+    Dim rel As DAO.Relation
+    Set rel = New DAO.Relation
+    
+    rel.Attributes = InFile.ReadLine
+    rel.name = InFile.ReadLine
+    rel.table = InFile.ReadLine
+    rel.foreignTable = InFile.ReadLine
+    
+    Dim f As DAO.Field
+    Do Until InFile.AtEndOfStream
+        If "Field = Begin" = InFile.ReadLine Then
+            Set f = New DAO.Field
+            f.name = InFile.ReadLine
+            f.ForeignName = InFile.ReadLine
+            If "End" <> InFile.ReadLine Then
+                Set f = Nothing
+                Err.Raise 40000, "ImportRelation", "Missing 'End' for a 'Begin' in " & filePath
+            End If
+            rel.Fields.Append f
+        End If
+    Loop
+    
+    InFile.Close
+    
+    CurrentDb.Relations.Append rel
+
+End Sub

MSAccess-VCS/VCS_Report.bas

@@ -0,0 +1,138 @@
+Attribute VB_Name = "VCS_Report"
+Option Compare Database
+
+Option Private Module
+Option Explicit
+
+' --------------------------------
+' Structures
+' --------------------------------
+
+Private Type str_DEVMODE
+  RGB As String * 94
+End Type
+
+Private Type type_DEVMODE
+  strDeviceName(31) As Byte 'vba strings are encoded in unicode (16 bit) not ascii
+  intSpecVersion As Integer
+  intDriverVersion As Integer
+  intSize As Integer
+  intDriverExtra As Integer
+  lngFields As Long
+  intOrientation As Integer
+  intPaperSize As Integer
+  intPaperLength As Integer
+  intPaperWidth As Integer
+  intScale As Integer
+  intCopies As Integer
+  intDefaultSource As Integer
+  intPrintQuality As Integer
+  intColor As Integer
+  intDuplex As Integer
+  intResolution As Integer
+  intTTOption As Integer
+  intCollate As Integer
+  strFormName(31) As Byte
+  lngPad As Long
+  lngBits As Long
+  lngPW As Long
+  lngPH As Long
+  lngDFI As Long
+  lngDFr As Long
+End Type
+
+
+'Exports print vars for reports
+Public Sub ExportPrintVars(ByVal obj_name As String, ByVal filePath As String)
+  DoEvents
+  Dim FSO As Object
+  Set FSO = CreateObject("Scripting.FileSystemObject")
+  
+  Dim DevModeString As str_DEVMODE
+  Dim DevModeExtra As String
+  Dim DM As type_DEVMODE
+  Dim rpt As Report
+  
+  'report must be open to access Report object
+  'report must be opened in design view to save changes to the print vars
+   DoCmd.OpenReport obj_name, acViewDesign
+   Set rpt = Reports(obj_name)
+  
+  
+  'read print vars into struct
+  If Not IsNull(rpt.PrtDevMode) Then
+    DevModeExtra = rpt.PrtDevMode
+    DevModeString.RGB = DevModeExtra
+    LSet DM = DevModeString
+  Else
+    Set rpt = Nothing
+    DoCmd.Close acReport, obj_name, acSaveNo
+    Debug.Print "Warning: PrtDevMode is null"
+    Exit Sub
+  End If
+  
+  Dim OutFile As Object
+  Set OutFile = FSO.CreateTextFile(filePath, overwrite:=True, Unicode:=False)
+  
+  'print out print var values
+  OutFile.WriteLine DM.intOrientation
+  OutFile.WriteLine DM.intPaperSize
+  OutFile.WriteLine DM.intPaperLength
+  OutFile.WriteLine DM.intPaperWidth
+  OutFile.WriteLine DM.intScale
+  OutFile.Close
+  
+  Set rpt = Nothing
+  
+  DoCmd.Close acReport, obj_name, acSaveYes
+End Sub
+
+Public Sub ImportPrintVars(ByVal obj_name As String, ByVal filePath As String)
+  
+  Dim FSO As Object
+  Set FSO = CreateObject("Scripting.FileSystemObject")
+  
+  Dim DevModeString As str_DEVMODE
+  Dim DevModeExtra As String
+  
+  Dim DM As type_DEVMODE
+  Dim rpt As Report
+  'report must be open to access Report object
+  'report must be opened in design view to save changes to the print vars
+  
+  DoCmd.OpenReport obj_name, acViewDesign
+  
+  Set rpt = Reports(obj_name)
+  
+  'read print vars into struct
+  If Not IsNull(rpt.PrtDevMode) Then
+    DevModeExtra = rpt.PrtDevMode
+    DevModeString.RGB = DevModeExtra
+    LSet DM = DevModeString
+  Else
+    Set rpt = Nothing
+    DoCmd.Close acReport, obj_name, acSaveNo
+    Debug.Print "Warning: PrtDevMode is null"
+    Exit Sub
+  End If
+  
+  Dim InFile As Object
+  Set InFile = FSO.OpenTextFile(filePath, iomode:=ForReading, create:=False, Format:=TristateFalse)
+  
+  'print out print var values
+  DM.intOrientation = InFile.ReadLine
+  DM.intPaperSize = InFile.ReadLine
+  DM.intPaperLength = InFile.ReadLine
+  DM.intPaperWidth = InFile.ReadLine
+  DM.intScale = InFile.ReadLine
+  InFile.Close
+   
+  'write print vars back into report
+  LSet DevModeString = DM
+  Mid(DevModeExtra, 1, 94) = DevModeString.RGB
+  rpt.PrtDevMode = DevModeExtra
+  
+  Set rpt = Nothing
+  
+  DoCmd.Close acReport, obj_name, acSaveYes
+End Sub

MSAccess-VCS/VCS_String.bas

@@ -0,0 +1,83 @@
+Attribute VB_Name = "VCS_String"
+Option Compare Database
+
+Option Private Module
+Option Explicit
+
+
+'--------------------
+' String Functions: String Builder,String Padding (right only), Substrings
+'--------------------
+
+' String builder: Init
+Public Function Sb_Init() As String()
+    Dim x(-1 To -1) As String
+    Sb_Init = x
+End Function
+
+' String builder: Clear
+Public Sub Sb_Clear(ByRef sb() As String)
+    ReDim Sb_Init(-1 To -1)
+End Sub
+
+' String builder: Append
+Public Sub Sb_Append(ByRef sb() As String, ByVal Value As String)
+    If LBound(sb) = -1 Then
+        ReDim sb(0 To 0)
+    Else
+        ReDim Preserve sb(0 To UBound(sb) + 1)
+    End If
+    sb(UBound(sb)) = Value
+End Sub
+
+' String builder: Get value
+Public Function Sb_Get(ByRef sb() As String) As String
+    Sb_Get = Join(sb, "")
+End Function
+
+
+' Pad a string on the right to make it `count` characters long.
+Public Function PadRight(ByVal Value As String, ByVal Count As Integer) As String
+    PadRight = Value
+    If Len(Value) < Count Then
+        PadRight = PadRight & Space$(Count - Len(Value))
+    End If
+End Function
+
+' returns substring between e.g. "(" and ")", internal brackets ar skippped
+Public Function SubString(ByVal p As Integer, ByVal s As String, ByVal startsWith As String, _
+                          ByVal endsWith As String) As String
+    Dim start As Integer
+    Dim cursor As Integer
+    Dim p1 As Integer
+    Dim p2 As Integer
+    Dim level As Integer
+    
+    start = InStr(p, s, startsWith)
+    level = 1
+    p1 = InStr(start + 1, s, startsWith)
+    p2 = InStr(start + 1, s, endsWith)
+    
+    Do While level > 0
+        If p1 > p2 And p2 > 0 Then
+            cursor = p2
+            level = level - 1
+        ElseIf p2 > p1 And p1 > 0 Then
+            cursor = p1
+            level = level + 1
+        ElseIf p2 > 0 And p1 = 0 Then
+            cursor = p2
+            level = level - 1
+        ElseIf p1 > 0 And p1 = 0 Then
+            cursor = p1
+            level = level + 1
+        ElseIf p1 = 0 And p2 = 0 Then
+            SubString = vbNullString
+            Exit Function
+        End If
+        p1 = InStr(cursor + 1, s, startsWith)
+        p2 = InStr(cursor + 1, s, endsWith)
+    Loop
+    
+    SubString = Mid$(s, start + 1, cursor - start - 1)
+End Function

MSAccess-VCS/VCS_Table.bas

@@ -0,0 +1,631 @@
+Attribute VB_Name = "VCS_Table"
+Option Compare Database
+
+Option Private Module
+Option Explicit
+
+' --------------------------------
+' Structures
+' --------------------------------
+
+' Structure to keep track of "on Update" and "on Delete" clauses
+' Access does not in all cases execute such queries
+Private Type structEnforce
+    foreignTable As String
+    foreignFields() As String
+    table As String
+    refFields() As String
+    isUpdate As Boolean
+End Type
+
+' keeping "on Update" relations to be complemented after table creation
+Private K() As structEnforce
+
+
+Public Sub ExportLinkedTable(ByVal tbl_name As String, ByVal obj_path As String)
+    On Error GoTo Err_LinkedTable
+    
+    Dim tempFilePath As String
+    
+    tempFilePath = VCS_File.TempFile()
+    
+    Dim FSO As Object
+    Dim OutFile As Object
+
+    Set FSO = CreateObject("Scripting.FileSystemObject")
+    ' 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)
+    
+    OutFile.Write CurrentDb.TableDefs(tbl_name).name
+    OutFile.Write vbCrLf
+    
+    If InStr(1, CurrentDb.TableDefs(tbl_name).connect, "DATABASE=" & CurrentProject.Path) Then
+        'change to relatave path
+        Dim connect() As String
+        connect = Split(CurrentDb.TableDefs(tbl_name).connect, CurrentProject.Path)
+        OutFile.Write connect(0) & "." & connect(1)
+    Else
+        OutFile.Write CurrentDb.TableDefs(tbl_name).connect
+    End If
+    
+    OutFile.Write vbCrLf
+    OutFile.Write CurrentDb.TableDefs(tbl_name).SourceTableName
+    OutFile.Write vbCrLf
+    
+    Dim Db As DAO.Database
+    Set Db = CurrentDb
+    Dim td As DAO.TableDef
+    Set td = Db.TableDefs(tbl_name)
+    Dim idx As DAO.Index
+    
+    For Each idx In td.Indexes
+        If idx.Primary Then
+            OutFile.Write Right$(idx.Fields, Len(idx.Fields) - 1)
+            OutFile.Write vbCrLf
+        End If
+
+    Next
+    
+Err_LinkedTable_Fin:
+    On Error Resume Next
+    OutFile.Close
+    'save files as .odbc
+    VCS_File.ConvertUcs2Utf8 tempFilePath, obj_path & tbl_name & ".LNKD"
+    
+    Exit Sub
+    
+Err_LinkedTable:
+    OutFile.Close
+    MsgBox Err.Description, vbCritical, "ERROR: EXPORT LINKED TABLE"
+    Resume Err_LinkedTable_Fin
+End Sub
+
+' This requires Microsoft ADO Ext. 2.x for DLL and Security
+' See reference: https://social.msdn.microsoft.com/Forums/office/en-US/883087ba-2c25-4571-bd3c-706061466a11/how-can-i-programmatically-access-scale-property-of-a-decimal-data-type-field?forum=accessdev
+Private Function formatDecimal(ByVal tableName As String, ByVal fieldName As String) As String
+
+    Dim cnn As ADODB.Connection
+    Dim cat As ADOX.Catalog
+    Dim col As ADOX.Column
+    
+    Set cnn = New ADODB.Connection
+    Set cat = New ADOX.Catalog
+    
+
+    Set cnn = CurrentProject.Connection
+    Set cat.ActiveConnection = cnn
+
+    Set col = cat.Tables(tableName).Columns(fieldName)
+
+    formatDecimal = "(" & col.Precision & ", " & col.NumericScale & ")"
+
+    Set col = Nothing
+    Set cat = Nothing
+    Set cnn = Nothing
+
+End Function
+
+' Save a Table Definition as SQL statement
+Public Sub ExportTableDef(Db As DAO.Database, td As DAO.TableDef, ByVal tableName As String, _
+                          ByVal directory As String)
+    Dim fileName As String
+    fileName = directory & tableName & ".sql"
+    Dim sql As String
+    Dim fieldAttributeSql As String
+    Dim idx As DAO.Index
+    Dim fi As DAO.Field
+    Dim FSO As Object
+    Dim OutFile As Object
+    Dim ff As Object
+    'Debug.Print tableName
+    Set FSO = CreateObject("Scripting.FileSystemObject")
+    Set OutFile = FSO.CreateTextFile(fileName, overwrite:=True, Unicode:=False)
+    sql = "CREATE TABLE " & strName(tableName) & " (" & vbCrLf
+    For Each fi In td.Fields
+        sql = sql & "  " & strName(fi.name) & " "
+        If (fi.Attributes And dbAutoIncrField) Then
+            sql = sql & "AUTOINCREMENT"
+        Else
+            sql = sql & strType(fi.Type) & " "
+        End If
+        Select Case fi.Type
+            Case dbText, dbVarBinary
+                sql = sql & "(" & fi.Size & ")"
+            Case dbDecimal
+                sql = sql & formatDecimal(tableName, fi.name)
+            Case Else
+        End Select
+        For Each idx In td.Indexes
+            fieldAttributeSql = vbNullString
+            If idx.Fields.Count = 1 And idx.Fields(0).name = fi.name Then
+                If idx.Primary Then fieldAttributeSql = fieldAttributeSql & " PRIMARY KEY "
+                If idx.Unique Then fieldAttributeSql = fieldAttributeSql & " UNIQUE "
+                If idx.Required Then fieldAttributeSql = fieldAttributeSql & " NOT NULL "
+                If idx.Foreign Then
+                    Set ff = idx.Fields
+                    fieldAttributeSql = fieldAttributeSql & formatReferences(Db, ff, tableName)
+                End If
+                If Len(fieldAttributeSql) > 0 Then fieldAttributeSql = " CONSTRAINT " & strName(idx.name) & fieldAttributeSql
+            End If
+            sql = sql & fieldAttributeSql
+        Next
+        sql = sql & "," & vbCrLf
+    Next
+    sql = Left$(sql, Len(sql) - 3) ' strip off last comma and crlf
+    
+    Dim constraintSql As String
+    For Each idx In td.Indexes
+        If idx.Fields.Count > 1 Then
+            If Len(constraintSql) = 0 Then constraintSql = constraintSql & " CONSTRAINT "
+            If idx.Primary Then constraintSql = constraintSql & formatConstraint("PRIMARY KEY", idx)
+            If Not idx.Foreign Then
+                If Len(constraintSql) > 0 Then
+                    sql = sql & "," & vbCrLf & "  " & constraintSql
+                    sql = sql & formatReferences(Db, idx.Fields, tableName)
+                End If
+            End If
+        End If
+    Next
+    sql = sql & vbCrLf & ")"
+
+    'Debug.Print sql
+    OutFile.WriteLine sql
+    
+    OutFile.Close
+    
+    'exort Data Macros
+    VCS_DataMacro.ExportDataMacros tableName, directory
+    
+End Sub
+
+Private Function formatReferences(Db As DAO.Database, ff As Object, _
+                                  ByVal tableName As String) As String
+
+    Dim rel As DAO.Relation
+    Dim sql As String
+    Dim f As DAO.Field
+    
+    For Each rel In Db.Relations
+        If (rel.foreignTable = tableName) Then
+         If FieldsIdentical(ff, rel.Fields) Then
+          sql = " REFERENCES "
+          sql = sql & strName(rel.table) & " ("
+          For Each f In rel.Fields
+            sql = sql & strName(f.name) & ","
+          Next
+          sql = Left$(sql, Len(sql) - 1) & ")"
+          If rel.Attributes And dbRelationUpdateCascade Then
+            sql = sql + " ON UPDATE CASCADE "
+          End If
+          If rel.Attributes And dbRelationDeleteCascade Then
+            sql = sql + " ON DELETE CASCADE "
+          End If
+          Exit For
+         End If
+        End If
+    Next
+    
+    formatReferences = sql
+End Function
+
+Private Function formatConstraint(ByVal keyw As String, ByVal idx As DAO.Index) As String
+    Dim sql As String
+    Dim fi As DAO.Field
+    
+    sql = strName(idx.name) & " " & keyw & " ("
+    For Each fi In idx.Fields
+        sql = sql & strName(fi.name) & ", "
+    Next
+    sql = Left$(sql, Len(sql) - 2) & ")" 'strip off last comma and close brackets
+    
+    'return value
+    formatConstraint = sql
+End Function
+
+Private Function strName(ByVal s As String) As String
+    strName = "[" & s & "]"
+End Function
+
+Private Function strType(ByVal i As Integer) As String
+    Select Case i
+    Case dbLongBinary
+        strType = "LONGBINARY"
+    Case dbBinary
+        strType = "BINARY"
+    Case dbBoolean
+        strType = "BIT"
+    Case dbAutoIncrField
+        strType = "COUNTER"
+    Case dbCurrency
+        strType = "CURRENCY"
+    Case dbDate, dbTime
+        strType = "DATETIME"
+    Case dbGUID
+        strType = "GUID"
+    Case dbMemo
+        strType = "LONGTEXT"
+    Case dbDouble
+        strType = "DOUBLE"
+    Case dbSingle
+        strType = "SINGLE"
+    Case dbByte
+        strType = "BYTE"
+    Case dbInteger
+        strType = "SHORT"
+    Case dbLong
+        strType = "LONG"
+    Case dbNumeric
+        strType = "NUMERIC"
+    Case dbText
+        strType = "VARCHAR"
+    Case dbDecimal
+        strType = "DECIMAL"
+    Case Else
+        strType = "VARCHAR"
+    End Select
+End Function
+
+Private Function FieldsIdentical(ff As Object, gg As Object) As Boolean
+    Dim f As DAO.Field
+    If ff.Count <> gg.Count Then
+        FieldsIdentical = False
+        Exit Function
+    End If
+    For Each f In ff
+        If Not FieldInFields(f, gg) Then
+        FieldsIdentical = False
+        Exit Function
+        End If
+    Next
+    
+    FieldsIdentical = True
+End Function
+
+Private Function FieldInFields(fi As DAO.Field, ff As DAO.Fields) As Boolean
+    Dim f As DAO.Field
+    For Each f In ff
+        If f.name = fi.name Then
+            FieldInFields = True
+            Exit Function
+        End If
+    Next
+    
+    FieldInFields = False
+End Function
+
+' Determine if a table or exists.
+' based on sample code of support.microsoftcom
+' ARGUMENTS:
+'    TName: The name of a table or query.
+'
+' RETURNS: True (it exists) or False (it does not exist).
+Private Function TableExists(ByVal TName As String) As Boolean
+    Dim Db As DAO.Database
+    Dim Found As Boolean
+    Dim Test As String
+    
+    Const NAME_NOT_IN_COLLECTION As Integer = 3265
+    
+     ' Assume the table or query does not exist.
+    Found = False
+    Set Db = CurrentDb()
+    
+     ' Trap for any errors.
+    On Error Resume Next
+     
+     ' See if the name is in the Tables collection.
+    Test = Db.TableDefs(TName).name
+    If Err.Number <> NAME_NOT_IN_COLLECTION Then Found = True
+    
+    ' Reset the error variable.
+    Err = 0
+    
+    TableExists = Found
+End Function
+
+' Build SQL to export `tbl_name` sorted by each field from first to last
+Private Function TableExportSql(ByVal tbl_name As String) As String
+    Dim rs As Object ' DAO.Recordset
+    Dim fieldObj As Object ' DAO.Field
+    Dim sb() As String, Count As Integer
+
+    Set rs = CurrentDb.OpenRecordset(tbl_name)
+    
+    sb = VCS_String.Sb_Init()
+    VCS_String.Sb_Append sb, "SELECT "
+    
+    Count = 0
+    For Each fieldObj In rs.Fields
+        If Count > 0 Then VCS_String.Sb_Append sb, ", "
+        VCS_String.Sb_Append sb, "[" & fieldObj.name & "]"
+        Count = Count + 1
+    Next
+    
+    VCS_String.Sb_Append sb, " FROM [" & tbl_name & "] ORDER BY "
+    
+    Count = 0
+    For Each fieldObj In rs.Fields
+        DoEvents
+        If Count > 0 Then VCS_String.Sb_Append sb, ", "
+        VCS_String.Sb_Append sb, "[" & fieldObj.name & "]"
+        Count = Count + 1
+    Next
+
+    TableExportSql = VCS_String.Sb_Get(sb)
+End Function
+
+' Export the lookup table `tblName` to `source\tables`.
+Public Sub ExportTableData(ByVal tbl_name As String, ByVal obj_path As String)
+    Dim FSO As Object
+    Dim OutFile As Object
+    Dim rs As DAO.Recordset ' DAO.Recordset
+    Dim fieldObj As Object ' DAO.Field
+    Dim c As Long, Value As Variant
+    
+    ' Checks first
+    If Not TableExists(tbl_name) Then
+        Debug.Print "Error: Table " & tbl_name & " missing"
+        Exit Sub
+    End If
+    
+    Set rs = CurrentDb.OpenRecordset(TableExportSql(tbl_name))
+    If rs.RecordCount = 0 Then
+        'why is this an error? Debug.Print "Error: Table " & tbl_name & "  empty"
+        rs.Close
+        Exit Sub
+    End If
+
+    Set FSO = CreateObject("Scripting.FileSystemObject")
+    ' open file for writing with Create=True, Unicode=True (USC-2 Little Endian format)
+    VCS_Dir.MkDirIfNotExist obj_path
+    Dim tempFileName As String
+    tempFileName = VCS_File.TempFile()
+
+    Set OutFile = FSO.CreateTextFile(tempFileName, overwrite:=True, Unicode:=True)
+
+    c = 0
+    For Each fieldObj In rs.Fields
+        If c <> 0 Then OutFile.Write vbTab
+        c = c + 1
+        OutFile.Write fieldObj.name
+    Next
+    OutFile.Write vbCrLf
+
+    rs.MoveFirst
+    Do Until rs.EOF
+        c = 0
+        For Each fieldObj In rs.Fields
+            DoEvents
+            If c <> 0 Then OutFile.Write vbTab
+            c = c + 1
+            Value = rs(fieldObj.name)
+            If IsNull(Value) Then
+                Value = vbNullString
+            Else
+                Value = Replace(Value, "\", "\\")
+                Value = Replace(Value, vbCrLf, "\n")
+                Value = Replace(Value, vbCr, "\n")
+                Value = Replace(Value, vbLf, "\n")
+                Value = Replace(Value, vbTab, "\t")
+            End If
+            OutFile.Write Value
+        Next
+        OutFile.Write vbCrLf
+        rs.MoveNext
+    Loop
+    rs.Close
+    OutFile.Close
+
+    VCS_File.ConvertUcs2Utf8 tempFileName, obj_path & tbl_name & ".txt"
+    FSO.DeleteFile tempFileName
+End Sub
+
+' Kill Table if Exists
+Private Sub KillTable(ByVal tblName As String, Db As Object)
+    If TableExists(tblName) Then
+        Db.Execute "DROP TABLE [" & tblName & "]"
+    End If
+End Sub
+
+Public Sub ImportLinkedTable(ByVal tblName As String, ByRef obj_path As String)
+    Dim Db As DAO.Database
+    Dim FSO As Object
+    Dim InFile As Object
+    
+    Set Db = CurrentDb
+    Set FSO = CreateObject("Scripting.FileSystemObject")
+    
+    Dim tempFilePath As String
+    tempFilePath = VCS_File.TempFile()
+    
+    ConvertUtf8Ucs2 obj_path & tblName & ".LNKD", tempFilePath
+    ' 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)
+    
+    On Error GoTo err_notable:
+    DoCmd.DeleteObject acTable, tblName
+    
+    GoTo err_notable_fin
+    
+err_notable:
+    Err.Clear
+    Resume err_notable_fin
+    
+err_notable_fin:
+    On Error GoTo Err_CreateLinkedTable:
+    
+    Dim td As DAO.TableDef
+    Set td = Db.CreateTableDef(InFile.ReadLine())
+    
+    Dim connect As String
+    connect = InFile.ReadLine()
+    If InStr(1, connect, "DATABASE=.\") Then 'replace relative path with literal path
+        connect = Replace(connect, "DATABASE=.\", "DATABASE=" & CurrentProject.Path & "\")
+    End If
+    td.connect = connect
+    
+    td.SourceTableName = InFile.ReadLine()
+    Db.TableDefs.Append td
+    
+    GoTo Err_CreateLinkedTable_Fin
+    
+Err_CreateLinkedTable:
+    MsgBox Err.Description, vbCritical, "ERROR: IMPORT LINKED TABLE"
+    Resume Err_CreateLinkedTable_Fin
+    
+Err_CreateLinkedTable_Fin:
+    'this will throw errors if a primary key already exists or the table is linked to an access database table
+    'will also error out if no pk is present
+    On Error GoTo Err_LinkPK_Fin:
+    
+    Dim Fields As String
+    Fields = InFile.ReadLine()
+    Dim Field As Variant
+    Dim sql As String
+    sql = "CREATE INDEX __uniqueindex ON " & td.name & " ("
+    
+    For Each Field In Split(Fields, ";+")
+        sql = sql & "[" & Field & "]" & ","
+    Next
+    'remove extraneous comma
+    sql = Left$(sql, Len(sql) - 1)
+    
+    sql = sql & ") WITH PRIMARY"
+    CurrentDb.Execute sql
+    
+Err_LinkPK_Fin:
+    On Error Resume Next
+    InFile.Close
+    
+End Sub
+
+' Import Table Definition
+Public Sub ImportTableDef(ByVal tblName As String, ByVal directory As String)
+    Dim filePath As String
+    filePath = directory & tblName & ".sql"
+    Dim Db As Object ' DAO.Database
+    Dim FSO As Object
+    Dim InFile As Object
+    Dim buf As String
+    Dim p As Integer
+    Dim p1 As Integer
+    Dim strMsg As String
+    Dim s As Variant
+    Dim n As Integer
+    Dim i As Integer
+    Dim j As Integer
+    Dim tempFileName As String
+    tempFileName = VCS_File.TempFile()
+
+    n = -1
+    Set FSO = CreateObject("Scripting.FileSystemObject")
+    VCS_File.ConvertUtf8Ucs2 filePath, tempFileName
+    ' 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 Db = CurrentDb
+    KillTable tblName, Db
+    buf = InFile.ReadLine()
+    Do Until InFile.AtEndOfStream
+        buf = buf & InFile.ReadLine()
+    Loop
+    
+    ' The following block is needed because "on update" actions may cause problems
+    For Each s In Split("UPDATE|DELETE", "|")
+      p = InStr(buf, "ON " & s & " CASCADE")
+      Do While p > 0
+          n = n + 1
+          ReDim Preserve K(n)
+          K(n).table = tblName
+          K(n).isUpdate = (s = "UPDATE")
+          
+          buf = Left$(buf, p - 1) & Mid$(buf, p + 18)
+          p = InStrRev(buf, "REFERENCES", p)
+          p1 = InStr(p, buf, "(")
+          K(n).foreignFields = Split(VCS_String.SubString(p1, buf, "(", ")"), ",")
+          K(n).foreignTable = Trim$(Mid$(buf, p + 10, p1 - p - 10))
+          p = InStrRev(buf, "CONSTRAINT", p1)
+          p1 = InStrRev(buf, "FOREIGN KEY", p1)
+          If (p1 > 0) And (p > 0) And (p1 > p) Then
+          ' multifield index
+              K(n).refFields = Split(VCS_String.SubString(p1, buf, "(", ")"), ",")
+          ElseIf p1 = 0 Then
+          ' single field
+          End If
+          p = InStr(p, "ON " & s & " CASCADE", buf)
+      Loop
+    Next
+    On Error Resume Next
+    For i = 0 To n
+        strMsg = K(i).table & " to " & K(i).foreignTable
+        strMsg = strMsg & "(  "
+        For j = 0 To UBound(K(i).refFields)
+            strMsg = strMsg & K(i).refFields(j) & ", "
+        Next j
+        strMsg = Left$(strMsg, Len(strMsg) - 2) & ") to ("
+        For j = 0 To UBound(K(i).foreignFields)
+            strMsg = strMsg & K(i).foreignFields(j) & ", "
+        Next j
+        strMsg = Left$(strMsg, Len(strMsg) - 2) & ") Check "
+        If K(i).isUpdate Then
+            strMsg = strMsg & " on update cascade " & vbCrLf
+        Else
+            strMsg = strMsg & " on delete cascade " & vbCrLf
+        End If
+    Next
+    On Error GoTo 0
+    Db.Execute buf
+    InFile.Close
+    If Len(strMsg) > 0 Then MsgBox strMsg, vbOKOnly, "Correct manually"
+        
+End Sub
+
+' Import the lookup table `tblName` from `source\tables`.
+Public Sub ImportTableData(ByVal tblName As String, ByVal obj_path As String)
+    Dim Db As Object ' DAO.Database
+    Dim rs As Object ' DAO.Recordset
+    Dim fieldObj As Object ' DAO.Field
+    Dim FSO As Object
+    Dim InFile As Object
+    Dim c As Long, buf As String, Values() As String, Value As Variant
+
+    Set FSO = CreateObject("Scripting.FileSystemObject")
+    
+    Dim tempFileName As String
+    tempFileName = VCS_File.TempFile()
+    VCS_File.ConvertUtf8Ucs2 obj_path & tblName & ".txt", tempFileName
+    ' 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 Db = CurrentDb
+
+    Db.Execute "DELETE FROM [" & tblName & "]"
+    Set rs = Db.OpenRecordset(tblName)
+    buf = InFile.ReadLine()
+    Do Until InFile.AtEndOfStream
+        buf = InFile.ReadLine()
+        If Len(Trim$(buf)) > 0 Then
+            Values = Split(buf, vbTab)
+            c = 0
+            rs.AddNew
+            For Each fieldObj In rs.Fields
+                DoEvents
+                Value = Values(c)
+                If Len(Value) = 0 Then
+                    Value = Null
+                Else
+                    Value = Replace(Value, "\t", vbTab)
+                    Value = Replace(Value, "\n", vbCrLf)
+                    Value = Replace(Value, "\\", "\")
+                End If
+                rs(fieldObj.name) = Value
+                c = c + 1
+            Next
+            rs.Update
+        End If
+    Loop
+
+    rs.Close
+    InFile.Close
+    FSO.DeleteFile tempFileName
+End Sub

README.md

@@ -0,0 +1,120 @@
+msaccess-vcs-integration
+
+[récupéré de [cette page](https://github.com/timabell/msaccess-vcs-integration)
+
+========================
+
+[![Join the chat at https://gitter.im/timabell/msaccess-vcs-integration](https://badges.gitter.im/timabell/msaccess-vcs-integration.svg)](https://gitter.im/timabell/msaccess-vcs-integration?utm_source=badge&utm_medium=badge&utm_campaign=pr-badge&utm_content=badge)
+
+About
+-----
+
+Synchronize your Microsoft Access Database definition with a version control system.
+
+Included in the export/import:
+
+* Queries
+* Forms
+* Reports
+* Macros
+* Modules
+* Table Data
+* Table Definitions
+* Table Data Macros
+
+Not included in the export/import:
+
+* Customized toolbars, toolbar items, and menu items
+* Any external files
+* Pretty much anything that is not accessible by browsing the design, properties, and code of a Query, Form, Report, Macro, or Module object.
+
+*This code is built and tested on Microsoft Access 2010/2013. It will probably work in earlier/later versions, but YMMV.*
+
+This README shows how to synchronize all application code objects from an Access application with a source control system such as Mercurial or Git. (The provided import/export module is agnostic about the actual source control system you use.)
+
+Encoding
+--------
+For Access objects which are normally exported in `UCS-2-little-endian` encoding , the included module automatically converts to the source code to and from `UTF-8` encoding during export/import; this is to ensure that you don't have trouble branching, merging, and comparing in tools such as Mercurial which [treat any file containing 0x00 bytes as a non-diffable binary file](http://mercurial.selenic.com/wiki/BinaryFiles).
+
+Output
+------
+The module will put the files in a folder called `source` within the same folder as your database file. The import expects the files to be in the same folder.
+
+
+Installing the Integration Scripts
+----------------------------------
+
+For the purposes of these instructions, assume your database is called `Application.accdb`.
+
+1. Load `VCS_Loader.bas` into a new module in your database with that exact name.
+ 1. Go to the VBA editor (CTRL-G) and select "File" > "Import File..."
+    (or you can just drag and drop the file from windows explorer into the vba editor module list).
+ 2. Select the `VCS_Loader.bas` file.
+ 3. Save the file (CTRL-S).
+2. Type "`loadVCS`" into the immediate window followed by the directory where the other VCS files are located. If you don't specify a directory then it is assumed that the VCS code is contained in a folder called 'MSAccess-VCS', in the database directory.
+e.g. `loadVCS "C:\Users\MyUserAccount\Documents\Access-Proj\MSAccess-VCS\"` - the trailing slash is required
+or `loadVCS`
+3. Edit your `VCS_ImportExport` and change the constant `INCLUDE_TABLES` to list any lookup tables that function more as part of your application code than as client data. (For example, "Countries", "Colors", and things like that.)
+4. Make sure there are references to DAO and ADOX - In the VBA editor, menu "Tools" > "References", select "Microsoft DAO 3.6 Object Library" and "Microsoft ADO Ext. 2.x for DLL and Security". Without this the "Database" and other references will cause compilation to fail with the message "Compile error: User-defined type not defined"
+5. If on compilation you get "Compile error: Method or data member not found" on "fi.Size" (Field), try re-ordering the dependencies to put ADO after DAO, as ADO (2.1) also defines field, but without the size member.
+
+Configuring export of table data
+--------------------------------
+
+By default, no table data is exported. You must specify which tables' data to include in the export/import process by editing the `INCLUDE_TABLES` variable in the supplied module. For example you might have "Countries" or "Colors" tables that populate dropdown lists. You shouldn't include regular data tables containing actual records, because this data doesn't belong in version control.
+
+Supplied databases
+------------------
+
+In the `demo\` folder there's a blank database that you can use with to provide with your source-controlled files, or to test the import; and a demo database with a sample of all the things that this project can import/export for trying the project out and testing any code changes made to the project.
+
+First Commit to Your Source Control System
+------------------------------------------
+
+1. Create a repository in the folder containing your database.
+2. Compact and Repair `Application.accdb` and zip it to `Application.zip` using the Send to Compressed Folder command in Windows Explorer.
+3. Using your repository's tools, set the repository to ignore any `.accdb` and `.laccdb` files, and then add and commit the zipped Access binary file `Application.zip`. Use a commit message like "Initial commit of [name] at version [number]."
+4. Open the application, hit CTRL-G, and run the following VB code in the Immediate window: "`ExportAllSource`". Wait for the Immediate window to say the export job is "Done."
+5. Using your repository's tools, add and commit all the new files that were created in the `source` folder. Use a commit message like "Initial commit of all source code for [name] at version [number]".
+6. Publish your repository to your preferred central sharing location.
+
+Committing New Progress and Pulling Changes from Other Developers
+-----------------------------------------------------------------
+
+1. Open the application, hit CTRL-G, and run the following VB code in the Immediate window: "`ExportAllSource`". Wait for the Immediate window to say the export job is "Done."
+2. Using your repository's tools, commit all the new files that were created in the source folder. Use an appropriate commit message to describe your changes.
+3. Pull new upstream changes (if any exist) from your central sharing location used by all developers. If necessary address any merge conflicts using your repository's merge and conflict resolution tools. If any work was done in this step, commit these changes to your local repository as well.
+4. Push all local and merged changes back to the central sharing location.
+5. Go back into the Access Immediate window (CTRL-G) and run the following VB code: "`ImportAllSource`". Wait for the Immediate window to say the export job is "Done."
+
+Committing a New "Release" of Your Project
+------------------------------------------
+
+1. There may be application changes that aren't covered in the source code for Forms, Macros, Modules, Queries, and Reports. To make sure these changes are recorded, Compact and Repair `Application.accdb` and zip it to `Application.zip` (replacing the old copy) using the Send to Compressed Folder command in Windows Explorer. Commit the new `Application.zip` to your repository with a commit message like "Full application binary for release [number]".
+2. Follow the usual steps in the previous section "Committing New Progress".
+3. Use your repository's "tag" function to tag your last commit with the release number/name.
+
+Loading/updating a database from the exported files
+---------------------------------------------------
+1. Create a new Access database (or use the supplied `demo\blank.accdb`).
+2. Follow the instructions for installing the scripts.
+3. Open the VBA editor (CTRL-G) and run the following VB code in the Immediate window: "`ImportProject`". You will be presented with a warning telling you that all database objects are about to be deleted, allowing you to cancel the operation if you change you mind.
+4. Wait until the code finishes executing, Compact and Repair the database.
+
+Caveats
+-------
+* If you make changes to or add a new module, be sure to save it in the VB Editor window or else it will not be exported.
+* If you make any changes to the scripts used in this process, the `VCS_` modules, they will not be automatically imported when any developer runs the `ImportProject` method. The code skips these files because it causes a conflict when trying to update a module that is actively being executed.
+
+
+Contributing
+============
+
+Pull requests, issue reports etc welcomed.
+
+https://github.com/timabell/msaccess-vcs-integration seems to currently be the
+most actively maintained branch, and [Tim Abell](https://github.com/timabell)
+will generally accept pull requests to keep the project alive but has minimal
+capacity to ensure correctness so please try and keep the quality as good as
+you can. Thanks! [jwbrookes](https://github.com/jwbrookes) also has commit
+access to this repository so can review and accept pull requests.

VCS_Loader.bas

@@ -0,0 +1,75 @@
+Attribute VB_Name = "VCS_Loader"
+Option Compare Database
+
+Option Explicit
+
+Public Sub loadVCS(Optional ByVal SourceDirectory As String)
+    If SourceDirectory = vbNullString Then
+      SourceDirectory = CurrentProject.Path & "\MSAccess-VCS\"
+    End If
+
+'check if directory exists! - SourceDirectory could be a file or not exist
+On Error GoTo Err_DirCheck
+    If ((GetAttr(SourceDirectory) And vbDirectory) = vbDirectory) Then
+        GoTo Fin_DirCheck
+    Else
+        'SourceDirectory is not a directory
+        Err.Raise 60000, "loadVCS", "Source Directory specified is not a directory"
+    End If
+
+Err_DirCheck:
+    
+    If Err.Number = 53 Then 'SourceDirectory does not exist
+        Debug.Print Err.Number & " | " & "File/Directory not found"
+    Else
+        Debug.Print Err.Number & " | " & Err.Description
+    End If
+    Exit Sub
+Fin_DirCheck:
+
+    'delete if modules already exist + provide warning of deletion?
+
+    On Error GoTo Err_DelHandler
+
+    Dim fileName As String
+    'Use the list of files to import as the list to delete
+    fileName = Dir$(SourceDirectory & "*.bas")
+    Do Until Len(fileName) = 0
+        'strip file type from file name
+        fileName = Left$(fileName, InStrRev(fileName, ".bas") - 1)
+        DoCmd.DeleteObject acModule, fileName
+        fileName = Dir$()
+    Loop
+
+    GoTo Fin_DelHandler
+    
+Err_DelHandler:
+    If Err.Number <> 7874 Then 'is not - can't find object
+        Debug.Print "WARNING (" & Err.Number & ") | " & Err.Description
+    End If
+    Resume Next
+    
+Fin_DelHandler:
+    fileName = vbNullString
+
+'import files from specific dir? or allow user to input their own dir?
+On Error GoTo Err_LoadHandler
+
+    fileName = Dir$(SourceDirectory & "*.bas")
+    Do Until Len(fileName) = 0
+        'strip file type from file name
+        fileName = Left$(fileName, InStrRev(fileName, ".bas") - 1)
+        Application.LoadFromText acModule, fileName, SourceDirectory & fileName & ".bas"
+        fileName = Dir$()
+    Loop
+
+    GoTo Fin_LoadHandler
+    
+Err_LoadHandler:
+    Debug.Print Err.Number & " | " & Err.Description
+    Resume Next
+
+Fin_LoadHandler:
+    Debug.Print "Done"
+
+End Sub