[
{
"path": ".gitattributes",
"content": "text eol=crlf\r\n"
},
{
"path": ".github/FUNDING.yml",
"content": "# These are supported funding model platforms\n\ngithub: # timabell\npatreon: timabell\nopen_collective: # Replace with a single Open Collective username\nko_fi: # Replace with a single Ko-fi username\ntidelift: # Replace with a single Tidelift platform-name/package-name e.g., npm/babel\ncommunity_bridge: # Replace with a single Community Bridge project-name e.g., cloud-foundry\nliberapay: # Replace with a single Liberapay username\nissuehunt: # Replace with a single IssueHunt username\notechie: # Replace with a single Otechie username\ncustom: # Replace with up to 4 custom sponsorship URLs e.g., ['link1', 'link2']\n"
},
{
"path": ".gitignore",
"content": "*.komodoproject\n\r\n*.accdb\r\n*.laccdb\r\n"
},
{
"path": "CHANGELOG.md",
"content": "Change log\n==========\n\nThis change log isn't being kept up to date any more, please see the git history for changes.\n\nVersion 1.0.1_beta - 7 April 2018\n----------------------------\nlastlink:\n* started a custom ui ribbon for nondevelopers to update forms that ignores tables with extendibility through the other button\n* added optional parameter for importing & exporting to ignore tables\n* added a message box to display version to users on `loadVCS`, shouldn't be version of this project, but of the user's actual access database forms so for this should always be 0.01\n\nVersion 1.0.0 - 11 Mar 2015\n----------------------------\njwbrookes:\n* Added support for Table Data Macros\n* Added support for Linked Tables (supports relative paths for linked files)\n* Added support for Print Variables in Reports (Page size and orientation) \n* Added support for Relation for all types of table\n* LoadVCS warnings removed when no object delete is required\n* Removed elements from Report export that change constantly but don't affect import\n* Fixed query import bug (complex queries being rearranged on import)\n* Fixed missing constraints in table export\n\nprmills:\n* Added support for bit fields in table Import/Export\n* Added support for References without GUIDs\n* Export all table data with `INCLUDE_TABLES = \"*\"`\n\nVersion 0.12.0 - 28 Jan 2015\n----------------------------\njwbrookes:\n* Refactored AppCodeImportExport into several modules\n* Added VCS_Loader, a module to import multiple vba modules into a database \n\n\nVersion 0.11.1 - 14 Jan 2015\n---------------------------\njwbrookes:\n* Fixed bug in ExportTableDef function\n* Removed redundant DeleteFile function (had been left commented out in the module)\n\n\nVersion 0.11 - 01 May 2014\n-------------------------\nmatonb:\n* Removed DeleteFile function and replaced calls to Kill with FileSystemObject.DeleteFile\n\n\nVersion 0.10 - 09 Mar 2014\n-------------------------\nmatonb:\n* Added DoEvents in loops to avoid \"Unresponsive\" state.\n\n\nVersion 0.9 - 15 Feb 2014\n-------------------------\nmatonb:\n* Aggressive Sanitise, moved BaseInfo from \"Block\" regex to Line level.\n* Changed line level skipping to include lines with deeper indendation the follow.\n This catches split lines mostly found in BaseInfo exports.\n\n\nVersion 0.8 - 14 Feb 2014\n-------------------------\nmatonb:\n* Aggressive Sanitise now excludes \"BaseInfo\" lines.\n These lines were seen to be randomly switching between being empty,\n not present or containing SQL on an arbitary basis.\n\n\nVersion 0.7 - 06 Jul 2013\n-------------------------\nmatonb:\n* Replaced TempFile function.\n* Temporary file names now generated via external MS libraries.\n* Functions using TempFile updated to only call TempFile function once.\n * Temporary file path and name stored in tmepFileName variable.\n * Temporary files deleted when done.\n* Changed db declaration in ImportProject to DAO.database.\n\n\nVersion 0.6 - 06 Jul 2013\n-------------------------\n\nmatonb:\n\n* AppcodeImportExport excluded from ExportAllSource\n* Added ImportProject sub-routine, \n Deletes all forms, macros, modules and queries before calling ImportAllSource. \n By clearing out the existing objects, you know that your database only contains \n code from your version control database. \n Excludes *AppCodeImportExport*\n\nVersion 0.5 - 29 May 2013\n--------------------------\n\nmatonb:\n\n* All \"exclusion\" patterns are now matched by regex.\n* Added StripPublishOption constant. \n If set to _True_ the following lines are also excluded from the export files\n * dbByte \"PublishToWeb\" =\"1\"\n * PublishOption =1\n* Added DeleteFile(FileName) function \n The function tries to delete _FileName_ three (3) times before giving up. \n A delay of 100ms is introduced between delete attempts should the first fail.\n\nVersion 0.4 - 19 Apr 2013\n--------------------------\n\nmatonb:\n\n* Added dbLongBinary \"DOL\" to aggressive sanitize, these statements were\n appearing in queries and being flagged by git as modified in files that\n hadn't been touched by developers.\n\nVersion 0.3.2 - 8 Apr 2013\n--------------------------\n\nmatonb:\n* 0.3.1 Patched - Serious Problem: SanitizeTextFiles If logic removed all\n lines containing \"Begin\".\n* 0.3.2 Replaced if block for skipping code sections in SanitizeTextFiles with\n regular expression.\n\nVersion 0.3 - 6 Apr 2013\n------------------------\n\nbkidwell:\n* Sanitize query exports.\n* Fixed SERIOUS TYPO in UCS2-to-UTF-8 conversion (wrong threshold for 2 byte versus 3 byte symbol in output stream).\n* AggressiveSanitize default True.\n\nmatonb:\n* Added AggressiveSanitize constant, it's a number to allow for different levels in the future. ~~Default False.~~\n* Added Skipping for GUID & Namemap in aggressive sanitize mode.\n* ~~If AggressiveSanitize is on, also sanitize query exports.~~\n* Append Number of objects imported/exported to information lines in immediate window.\n* Updated readme (removed references to terminal window).\n* Close all open forms and reports when importing and exporting because you can't import an open form or report.\n\nVersion 0.2 - 4 Apr 2013\n------------------------\n\nmatonb:\n* Added dbLongBinary \"DOL\" to SkipList in SanitizeTextFiles.\n* Added Source directory check to ImportAllSource, pops up a message box if missing.\n* Only create source directories if there is something to export.\n\nbkidwell:\n* Removed external executable for converting UCS-2-little-endian to and from UTF-8; replaced with VB6 methods.\n* Added demo database to the repository.\n* Removed the need for a special \"export_[name]\" query to export and import a lookup table.\n* 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.\n\nVersion 0.1 - 22 Oct 2012\n-------------------------\n\nInitial release\n"
},
{
"path": "LICENSE.txt",
"content": "Copyright © 2012 Brendan Kidwell et al\r\n\r\nUse of msaccess-vcs-integration and documentation are subject to the following\r\nBSD-style license:\r\n\r\nPermission to use, copy, modify, and/or distribute this software for any purpose\r\nwith or without fee is hereby granted, provided that the above copyright notice\r\nand this permission notice appear in all copies.\r\n\r\nTHE SOFTWARE IS PROVIDED \"AS IS\" AND THE AUTHOR DISCLAIMS ALL WARRANTIES WITH\r\nREGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND\r\nFITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY SPECIAL, DIRECT,\r\nINDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM LOSS\r\nOF USE, DATA OR PROFITS, WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER\r\nTORTIOUS ACTION, ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF\r\nTHIS SOFTWARE.\r\n"
},
{
"path": "MSAccess-VCS/VCS_Button_Functions.bas",
"content": "Attribute VB_Name = \"VCS_Button_Functions\"\nOption Compare Database\n\n' function to call update functions from button clicks\nFunction subUpdateBtn(btnFunction As String)\n ' do this every time\n ' loadVCS\n\n ' update form not tables\n ' export form\n ' reset form, w/ lookup tables, prompt user to confirm\n '& btnFunction\n Select Case btnFunction\n Case \"updateFormsBtn\" ', \"exportFormsBtn\", \"resetFormsBtn\"\n Debug.Print \"button worked: \" & btnFunction\n ImportProject (True)\n Case \"exportFormsBtn\"\n Debug.Print \"button worked2: \" & btnFunction\n ExportAllSource (True) ' will skip exporting tables\n Case Else\n MsgBox \"current function doesn't yet exist\"\n End Select\n\nEnd Function\n' filler for things like reset\nFunction formDialog()\n \n 'Variable Declaration\n Dim OutPut As Integer\n\n 'Example of vbDefaultButton2\n OutPut = MsgBox(\"Close the File.Try Again?\", vbYesNoCancel + vbDefaultButton3, \"Example of vbDefaultButton3\")\n\nEnd Function\n"
},
{
"path": "MSAccess-VCS/VCS_DataMacro.bas",
"content": "Attribute VB_Name = \"VCS_DataMacro\"\r\nOption Compare Database\r\n\r\nOption Private Module\r\nOption Explicit\r\n\r\n\r\n' For Access 2007 (VBA6) and earlier\r\n#If Not VBA7 Then\r\n Private Const acTableDataMacro As Integer = 12\r\n#End If\r\n\r\nPublic Sub VCS_ExportDataMacros(ByVal tableName As String, ByVal directory As String)\r\n On Error GoTo Err_export\r\n Dim filePath As String\r\n\r\n filePath = directory & tableName & \".dm\"\r\n\r\n VCS_IE_Functions.VCS_ExportObject acTableDataMacro, tableName, filePath, VCS_File.VCS_UsingUcs2\r\n FormatDataMacro filePath\r\n\r\n Exit Sub\r\n\r\nErr_export:\r\n ' Error to export dataMacro, no contains dataMacro. Do nothing\r\nEnd Sub\r\n\r\nPublic Sub VCS_ImportDataMacros(ByVal tableName As String, ByVal directory As String)\r\n On Error GoTo Err_import\r\n Dim filePath As String\r\n\r\n filePath = directory & tableName & \".dm\"\r\n VCS_IE_Functions.VCS_ImportObject acTableDataMacro, tableName, filePath, VCS_File.VCS_UsingUcs2\r\n \r\n Exit Sub\r\n \r\nErr_import:\r\n ' Error to import dataMacro. Do nothing\r\nEnd Sub\r\n\r\n'Splits exported DataMacro XML onto multiple lines\r\n'Allows git to find changes within lines using diff\r\nPrivate Sub FormatDataMacro(ByVal filePath As String)\r\n\r\n Dim saveStream As Object 'ADODB.Stream\r\n\r\n Set saveStream = CreateObject(\"ADODB.Stream\")\r\n saveStream.Charset = \"utf-8\"\r\n saveStream.Type = 2 'adTypeText\r\n saveStream.Open\r\n\r\n Dim objStream As Object 'ADODB.Stream\r\n Dim strData As String\r\n Set objStream = CreateObject(\"ADODB.Stream\")\r\n\r\n objStream.Charset = \"utf-8\"\r\n objStream.Type = 2 'adTypeText\r\n objStream.Open\r\n objStream.LoadFromFile (filePath)\r\n \r\n Do While Not objStream.EOS\r\n strData = objStream.ReadText(-2) 'adReadLine\r\n\r\n Dim tag As Variant\r\n \r\n For Each tag In Split(strData, \">\")\r\n If tag <> vbNullString Then\r\n saveStream.WriteText tag & \">\", 1 'adWriteLine\r\n End If\r\n Next\r\n \r\n Loop\r\n \r\n objStream.Close\r\n saveStream.SaveToFile filePath, 2 'adSaveCreateOverWrite\r\n saveStream.Close\r\n\r\nEnd Sub"
},
{
"path": "MSAccess-VCS/VCS_Dir.bas",
"content": "Attribute VB_Name = \"VCS_Dir\"\r\nOption Compare Database\r\n\r\nOption Private Module\r\nOption Explicit\r\n\r\n\r\n' Path/Directory of the current database file.\r\nPublic Function VCS_ProjectPath() As String\r\n VCS_ProjectPath = CurrentProject.Path\r\n If Right$(VCS_ProjectPath, 1) <> \"\\\" Then VCS_ProjectPath = VCS_ProjectPath & \"\\\"\r\nEnd Function\r\n\r\n' Create folder `Path`. Silently do nothing if it already exists.\r\nPublic Sub VCS_MkDirIfNotExist(ByVal Path As String)\r\n On Error GoTo MkDirIfNotexist_noop\r\n MkDir Path\r\nMkDirIfNotexist_noop:\r\n On Error GoTo 0\r\nEnd Sub\r\n\r\n' Delete a file if it exists.\r\nPublic Sub VCS_DelIfExist(ByVal Path As String)\r\n On Error GoTo DelIfNotExist_Noop\r\n Kill Path\r\nDelIfNotExist_Noop:\r\n On Error GoTo 0\r\nEnd Sub\r\n\r\n' Erase all *.`ext` files in `Path`.\r\nPublic Sub VCS_ClearTextFilesFromDir(ByVal Path As String, ByVal Ext As String)\r\n Dim FSO As Object\r\n Set FSO = CreateObject(\"Scripting.FileSystemObject\")\r\n If Not FSO.FolderExists(Path) Then Exit Sub\r\n\r\n On Error GoTo VCS_ClearTextFilesFromDir_noop\r\n If Dir$(Path & \"*.\" & Ext) <> vbNullString Then\r\n FSO.DeleteFile Path & \"*.\" & Ext\r\n End If\r\n \r\nVCS_ClearTextFilesFromDir_noop:\r\n On Error GoTo 0\r\nEnd Sub\r\n\r\nPublic Function VCS_FileExists(ByVal strPath As String) As Boolean\r\n On Error Resume Next\r\n VCS_FileExists = False\r\n VCS_FileExists = ((GetAttr(strPath) And vbDirectory) <> vbDirectory)\r\nEnd Function"
},
{
"path": "MSAccess-VCS/VCS_File.bas",
"content": "Attribute VB_Name = \"VCS_File\"\r\nOption Compare Database\r\n\r\nOption Private Module\r\nOption Explicit\r\n\r\n#If VBA7 Then\r\n Private Declare PtrSafe _\r\n Function getTempPath Lib \"kernel32\" _\r\n Alias \"GetTempPathA\" (ByVal nBufferLength As Long, _\r\n ByVal lpBuffer As String) As Long\r\n Private Declare PtrSafe _\r\n Function getTempFileName Lib \"kernel32\" _\r\n Alias \"GetTempFileNameA\" (ByVal lpszPath As String, _\r\n ByVal lpPrefixString As String, _\r\n ByVal wUnique As Long, _\r\n ByVal lpTempFileName As String) As Long\r\n#Else\r\n Private Declare _\r\n Function getTempPath Lib \"kernel32\" _\r\n Alias \"GetTempPathA\" (ByVal nBufferLength As Long, _\r\n ByVal lpBuffer As String) As Long\r\n Private Declare _\r\n Function getTempFileName Lib \"kernel32\" _\r\n Alias \"GetTempFileNameA\" (ByVal lpszPath As String, _\r\n ByVal lpPrefixString As String, _\r\n ByVal wUnique As Long, _\r\n ByVal lpTempFileName As String) As Long\r\n#End If\r\n\r\n' --------------------------------\r\n' Structures\r\n' --------------------------------\r\n\r\n' Structure to track buffered reading or writing of binary files\r\nPrivate Type BinFile\r\n file_num As Integer\r\n file_len As Long\r\n file_pos As Long\r\n buffer As String\r\n buffer_len As Integer\r\n buffer_pos As Integer\r\n at_eof As Boolean\r\n mode As String\r\nEnd Type\r\n\r\n\r\n' --------------------------------\r\n' Basic functions missing from VB 6: buffered file read/write, string builder, encoding check & conversion\r\n' --------------------------------\r\n\r\n' Open a binary file for reading (mode = 'r') or writing (mode = 'w').\r\nPrivate Function BinOpen(ByVal file_path As String, ByVal mode As String) As BinFile\r\n Dim f As BinFile\r\n\r\n f.file_num = FreeFile\r\n f.mode = LCase$(mode)\r\n If f.mode = \"r\" Then\r\n Open file_path For Binary Access Read As f.file_num\r\n f.file_len = LOF(f.file_num)\r\n f.file_pos = 0\r\n If f.file_len > &H4000 Then\r\n f.buffer = String$(&H4000, \" \")\r\n f.buffer_len = &H4000\r\n Else\r\n f.buffer = String$(f.file_len, \" \")\r\n f.buffer_len = f.file_len\r\n End If\r\n f.buffer_pos = 0\r\n Get f.file_num, f.file_pos + 1, f.buffer\r\n Else\r\n VCS_DelIfExist file_path\r\n Open file_path For Binary Access Write As f.file_num\r\n f.file_len = 0\r\n f.file_pos = 0\r\n f.buffer = String$(&H4000, \" \")\r\n f.buffer_len = 0\r\n f.buffer_pos = 0\r\n End If\r\n\r\n BinOpen = f\r\nEnd Function\r\n\r\n' Buffered read one byte at a time from a binary file.\r\nPrivate Function BinRead(ByRef f As BinFile) As Integer\r\n If f.at_eof = True Then\r\n BinRead = 0\r\n Exit Function\r\n End If\r\n\r\n BinRead = Asc(Mid$(f.buffer, f.buffer_pos + 1, 1))\r\n\r\n f.buffer_pos = f.buffer_pos + 1\r\n If f.buffer_pos >= f.buffer_len Then\r\n f.file_pos = f.file_pos + &H4000\r\n If f.file_pos >= f.file_len Then\r\n f.at_eof = True\r\n Exit Function\r\n End If\r\n If f.file_len - f.file_pos > &H4000 Then\r\n f.buffer_len = &H4000\r\n Else\r\n f.buffer_len = f.file_len - f.file_pos\r\n f.buffer = String$(f.buffer_len, \" \")\r\n End If\r\n f.buffer_pos = 0\r\n Get f.file_num, f.file_pos + 1, f.buffer\r\n End If\r\nEnd Function\r\n\r\n' Buffered write one byte at a time from a binary file.\r\nPrivate Sub BinWrite(ByRef f As BinFile, b As Integer)\r\n Mid(f.buffer, f.buffer_pos + 1, 1) = Chr$(b)\r\n f.buffer_pos = f.buffer_pos + 1\r\n If f.buffer_pos >= &H4000 Then\r\n Put f.file_num, , f.buffer\r\n f.buffer_pos = 0\r\n End If\r\nEnd Sub\r\n\r\n' Close binary file.\r\nPrivate Sub BinClose(ByRef f As BinFile)\r\n If f.mode = \"w\" And f.buffer_pos > 0 Then\r\n f.buffer = Left$(f.buffer, f.buffer_pos)\r\n Put f.file_num, , f.buffer\r\n End If\r\n Close f.file_num\r\nEnd Sub\r\n\r\n\r\n' Binary convert a UCS2-little-endian encoded file to UTF-8.\r\nPublic Sub VCS_ConvertUcs2Utf8(ByVal Source As String, ByVal dest As String)\r\n Dim f_in As BinFile\r\n Dim f_out As BinFile\r\n Dim in_low As Integer\r\n Dim in_high As Integer\r\n\r\n f_in = BinOpen(Source, \"r\")\r\n f_out = BinOpen(dest, \"w\")\r\n\r\n Do While Not f_in.at_eof\r\n in_low = BinRead(f_in)\r\n in_high = BinRead(f_in)\r\n If in_high = 0 And in_low < &H80 Then\r\n ' U+0000 - U+007F 0LLLLLLL\r\n BinWrite f_out, in_low\r\n ElseIf in_high < &H8 Then\r\n ' U+0080 - U+07FF 110HHHLL 10LLLLLL\r\n BinWrite f_out, &HC0 + ((in_high And &H7) * &H4) + ((in_low And &HC0) / &H40)\r\n BinWrite f_out, &H80 + (in_low And &H3F)\r\n Else\r\n ' U+0800 - U+FFFF 1110HHHH 10HHHHLL 10LLLLLL\r\n BinWrite f_out, &HE0 + ((in_high And &HF0) / &H10)\r\n BinWrite f_out, &H80 + ((in_high And &HF) * &H4) + ((in_low And &HC0) / &H40)\r\n BinWrite f_out, &H80 + (in_low And &H3F)\r\n End If\r\n Loop\r\n\r\n BinClose f_in\r\n BinClose f_out\r\nEnd Sub\r\n\r\n' Binary convert a UTF-8 encoded file to UCS2-little-endian.\r\nPublic Sub VCS_ConvertUtf8Ucs2(ByVal Source As String, ByVal dest As String)\r\n Dim f_in As BinFile\r\n Dim f_out As BinFile\r\n Dim in_1 As Integer\r\n Dim in_2 As Integer\r\n Dim in_3 As Integer\r\n\r\n f_in = BinOpen(Source, \"r\")\r\n f_out = BinOpen(dest, \"w\")\r\n\r\n Do While Not f_in.at_eof\r\n in_1 = BinRead(f_in)\r\n If (in_1 And &H80) = 0 Then\r\n ' U+0000 - U+007F 0LLLLLLL\r\n BinWrite f_out, in_1\r\n BinWrite f_out, 0\r\n ElseIf (in_1 And &HE0) = &HC0 Then\r\n ' U+0080 - U+07FF 110HHHLL 10LLLLLL\r\n in_2 = BinRead(f_in)\r\n BinWrite f_out, ((in_1 And &H3) * &H40) + (in_2 And &H3F)\r\n BinWrite f_out, (in_1 And &H1C) / &H4\r\n Else\r\n ' U+0800 - U+FFFF 1110HHHH 10HHHHLL 10LLLLLL\r\n in_2 = BinRead(f_in)\r\n in_3 = BinRead(f_in)\r\n BinWrite f_out, ((in_2 And &H3) * &H40) + (in_3 And &H3F)\r\n BinWrite f_out, ((in_1 And &HF) * &H10) + ((in_2 And &H3C) / &H4)\r\n End If\r\n Loop\r\n\r\n BinClose f_in\r\n BinClose f_out\r\nEnd Sub\r\n\r\n' Determine if this database imports/exports code as UCS-2-LE. (Older file\r\n' formats cause exported objects to use a Windows 8-bit character set.)\r\nPublic Function VCS_UsingUcs2() As Boolean\r\n Dim obj_name As String\r\n Dim obj_type As Variant\r\n Dim fn As Integer\r\n Dim bytes As String\r\n Dim obj_type_split() As String\r\n Dim obj_type_name As String\r\n Dim obj_type_num As Integer\r\n \r\n If CurrentDb.QueryDefs.Count > 0 Then\r\n obj_type_num = acQuery\r\n obj_name = CurrentDb.QueryDefs(0).Name\r\n Else\r\n For Each obj_type In Split( _\r\n \"Forms|\" & acForm & \",\" & _\r\n \"Reports|\" & acReport & \",\" & _\r\n \"Scripts|\" & acMacro & \",\" & _\r\n \"Modules|\" & acModule _\r\n )\r\n DoEvents\r\n obj_type_split = Split(obj_type, \"|\")\r\n obj_type_name = obj_type_split(0)\r\n obj_type_num = Val(obj_type_split(1))\r\n If CurrentDb.Containers(obj_type_name).Documents.Count > 0 Then\r\n obj_name = CurrentDb.Containers(obj_type_name).Documents(0).Name\r\n Exit For\r\n End If\r\n Next\r\n End If\r\n\r\n If obj_name = vbNullString Then\r\n ' No objects found that can be used to test UCS2 versus UTF-8\r\n VCS_UsingUcs2 = True\r\n Exit Function\r\n End If\r\n\r\n Dim tempFileName As String\r\n tempFileName = VCS_File.VCS_TempFile()\r\n \r\n Application.SaveAsText obj_type_num, obj_name, tempFileName\r\n fn = FreeFile\r\n Open tempFileName For Binary Access Read As fn\r\n bytes = \" \"\r\n Get fn, 1, bytes\r\n If Asc(Mid$(bytes, 1, 1)) = &HFF And Asc(Mid$(bytes, 2, 1)) = &HFE Then\r\n VCS_UsingUcs2 = True\r\n Else\r\n VCS_UsingUcs2 = False\r\n End If\r\n Close fn\r\n \r\n Dim FSO As Object\r\n Set FSO = CreateObject(\"Scripting.FileSystemObject\")\r\n FSO.DeleteFile (tempFileName)\r\nEnd Function\r\n\r\n' Generate Random / Unique temporary file name.\r\nPublic Function VCS_TempFile(Optional ByVal sPrefix As String = \"VBA\") As String\r\n Dim sTmpPath As String * 512\r\n Dim sTmpName As String * 576\r\n Dim nRet As Long\r\n Dim sFileName As String\r\n \r\n nRet = getTempPath(512, sTmpPath)\r\n nRet = getTempFileName(sTmpPath, sPrefix, 0, sTmpName)\r\n If nRet <> 0 Then sFileName = Left$(sTmpName, InStr(sTmpName, vbNullChar) - 1)\r\n VCS_TempFile = sFileName\r\nEnd Function"
},
{
"path": "MSAccess-VCS/VCS_IE_Functions.bas",
"content": "Attribute VB_Name = \"VCS_IE_Functions\"\r\nOption Compare Database\r\n\r\nOption Private Module\r\nOption Explicit\r\n\r\n#If VBA7 Then\r\n Private Declare PtrSafe Sub Sleep Lib \"kernel32\" (ByVal dwMilliseconds As Long)\r\n#Else\r\n Private Declare Sub Sleep Lib \"kernel32\" (ByVal dwMilliseconds As Long)\r\n#End If\r\nPrivate Const AggressiveSanitize As Boolean = True\r\nPrivate Const StripPublishOption As Boolean = True\r\n\r\n' Constants for Scripting.FileSystemObject API\r\nPublic Const ForReading = 1, ForWriting = 2, ForAppending = 8\r\nPublic Const TristateTrue = -1, TristateFalse = 0, TristateUseDefault = -2\r\n\r\n\r\n' Can we export without closing the form?\r\n\r\n' Export a database object with optional UCS2-to-UTF-8 conversion.\r\nPublic Sub VCS_ExportObject(ByVal obj_type_num As Integer, ByVal obj_name As String, _\r\n ByVal file_path As String, Optional ByVal Ucs2Convert As Boolean = False)\r\n\r\n VCS_Dir.VCS_MkDirIfNotExist Left$(file_path, InStrRev(file_path, \"\\\"))\r\n If Ucs2Convert Then\r\n Dim tempFileName As String\r\n tempFileName = VCS_File.VCS_TempFile()\r\n Application.SaveAsText obj_type_num, obj_name, tempFileName\r\n VCS_File.VCS_ConvertUcs2Utf8 tempFileName, file_path\r\n Else\r\n Application.SaveAsText obj_type_num, obj_name, file_path\r\n End If\r\nEnd Sub\r\n\r\n' Import a database object with optional UTF-8-to-UCS2 conversion.\r\nPublic Sub VCS_ImportObject(ByVal obj_type_num As Integer, ByVal obj_name As String, _\r\n ByVal file_path As String, Optional ByVal Ucs2Convert As Boolean = False)\r\n \r\n If Not VCS_Dir.VCS_FileExists(file_path) Then Exit Sub\r\n \r\n If Ucs2Convert Then\r\n Dim tempFileName As String\r\n tempFileName = VCS_File.VCS_TempFile()\r\n VCS_File.VCS_ConvertUtf8Ucs2 file_path, tempFileName\r\n Application.LoadFromText obj_type_num, obj_name, tempFileName\r\n \r\n Dim FSO As Object\r\n Set FSO = CreateObject(\"Scripting.FileSystemObject\")\r\n FSO.DeleteFile tempFileName\r\n Else\r\n Application.LoadFromText obj_type_num, obj_name, file_path\r\n End If\r\nEnd Sub\r\n\r\n'shouldn't this be SanitizeTextFile (Singular)?\r\n\r\n' For each *.txt in `Path`, find and remove a number of problematic but\r\n' unnecessary lines of VB code that are inserted automatically by the\r\n' Access GUI and change often (we don't want these lines of code in\r\n' version control).\r\nPublic Sub VCS_SanitizeTextFiles(ByVal Path As String, ByVal Ext As String)\r\n\r\n Dim FSO As Object\r\n Set FSO = CreateObject(\"Scripting.FileSystemObject\")\r\n '\r\n ' Setup Block matching Regex.\r\n Dim rxBlock As Object\r\n Set rxBlock = CreateObject(\"VBScript.RegExp\")\r\n rxBlock.ignoreCase = False\r\n '\r\n ' Match PrtDevNames / Mode with or without W\r\n Dim srchPattern As String\r\n srchPattern = \"PrtDev(?:Names|Mode)[W]?\"\r\n If (AggressiveSanitize = True) Then\r\n ' Add and group aggressive matches\r\n srchPattern = \"(?:\" & srchPattern\r\n srchPattern = srchPattern & \"|GUID|\"\"GUID\"\"|NameMap|dbLongBinary \"\"DOL\"\"\"\r\n srchPattern = srchPattern & \")\"\r\n End If\r\n ' Ensure that this is the beginning of a block.\r\n srchPattern = srchPattern & \" = Begin\"\r\n'Debug.Print srchPattern\r\n rxBlock.Pattern = srchPattern\r\n '\r\n ' Setup Line Matching Regex.\r\n Dim rxLine As Object\r\n Set rxLine = CreateObject(\"VBScript.RegExp\")\r\n srchPattern = \"^\\s*(?:\"\r\n srchPattern = srchPattern & \"Checksum =\"\r\n srchPattern = srchPattern & \"|BaseInfo|NoSaveCTIWhenDisabled =1\"\r\n If (StripPublishOption = True) Then\r\n srchPattern = srchPattern & \"|dbByte \"\"PublishToWeb\"\" =\"\"1\"\"\"\r\n srchPattern = srchPattern & \"|PublishOption =1\"\r\n End If\r\n srchPattern = srchPattern & \")\"\r\n'Debug.Print srchPattern\r\n rxLine.Pattern = srchPattern\r\n Dim fileName As String\r\n fileName = Dir$(Path & \"*.\" & Ext)\r\n Dim isReport As Boolean\r\n isReport = False\r\n \r\n Do Until Len(fileName) = 0\r\n DoEvents\r\n Dim obj_name As String\r\n obj_name = Mid$(fileName, 1, InStrRev(fileName, \".\") - 1)\r\n\r\n Dim InFile As Object\r\n Set InFile = FSO.OpenTextFile(Path & obj_name & \".\" & Ext, iomode:=ForReading, create:=False, Format:=TristateFalse)\r\n Dim OutFile As Object\r\n Set OutFile = FSO.CreateTextFile(Path & obj_name & \".sanitize\", overwrite:=True, Unicode:=False)\r\n \r\n Dim getLine As Boolean\r\n getLine = True\r\n \r\n Do Until InFile.AtEndOfStream\r\n DoEvents\r\n Dim txt As String\r\n '\r\n ' Check if we need to get a new line of text\r\n If getLine = True Then\r\n txt = InFile.ReadLine\r\n Else\r\n getLine = True\r\n End If\r\n '\r\n ' Skip lines starting with line pattern\r\n If rxLine.Test(txt) Then\r\n Dim rxIndent As Object\r\n Set rxIndent = CreateObject(\"VBScript.RegExp\")\r\n rxIndent.Pattern = \"^(\\s+)\\S\"\r\n '\r\n ' Get indentation level.\r\n Dim matches As Object\r\n Set matches = rxIndent.Execute(txt)\r\n '\r\n ' Setup pattern to match current indent\r\n Select Case matches.Count\r\n Case 0\r\n rxIndent.Pattern = \"^\" & vbNullString\r\n Case Else\r\n rxIndent.Pattern = \"^\" & matches(0).SubMatches(0)\r\n End Select\r\n rxIndent.Pattern = rxIndent.Pattern + \"\\s\"\r\n '\r\n ' Skip lines with deeper indentation\r\n Do Until InFile.AtEndOfStream\r\n txt = InFile.ReadLine\r\n If Not rxIndent.Test(txt) Then Exit Do\r\n Loop\r\n ' We've moved on at least one line so do get a new one\r\n ' when starting the loop again.\r\n getLine = False\r\n '\r\n ' skip blocks of code matching block pattern\r\n ElseIf rxBlock.Test(txt) Then\r\n Do Until InFile.AtEndOfStream\r\n txt = InFile.ReadLine\r\n If InStr(txt, \"End\") Then Exit Do\r\n Loop\r\n ElseIf InStr(1, txt, \"Begin Report\") = 1 Then\r\n isReport = True\r\n OutFile.WriteLine txt\r\n ElseIf isReport = True And (InStr(1, txt, \" Right =\") Or InStr(1, txt, \" Bottom =\")) Then\r\n 'skip line\r\n If InStr(1, txt, \" Bottom =\") Then\r\n isReport = False\r\n End If\r\n Else\r\n OutFile.WriteLine txt\r\n End If\r\n Loop\r\n OutFile.Close\r\n InFile.Close\r\n\r\n FSO.DeleteFile (Path & fileName)\r\n\r\n Dim thisFile As Object\r\n Set thisFile = FSO.GetFile(Path & obj_name & \".sanitize\")\r\n \r\n ' Error Handling to deal with errors caused by Dropbox, VirusScan,\r\n ' or anything else touching the file.\r\n Dim ErrCounter As Integer\r\n On Error GoTo ErrorHandler\r\n thisFile.Move (Path & fileName)\r\n fileName = Dir$()\r\n Loop\r\n \r\n Exit Sub\r\nErrorHandler:\r\n ErrCounter = ErrCounter + 1\r\n If ErrCounter = 20 Then ' 20 attempts seems like a nice arbitrary number\r\n MsgBox \"This file could not be moved: \" & vbNewLine, vbCritical + vbApplicationModal, _\r\n \"Error moving file...\"\r\n Resume Next\r\n End If\r\n Select Case Err.Number\r\n Case 58 ' \"File already exists\" error.\r\n DoEvents\r\n Sleep 10\r\n Resume ' Go back to what you were doing\r\n Case Else\r\n MsgBox \"This file could not be moved: \" & vbNewLine, vbCritical + vbApplicationModal, _\r\n \"Error moving file...\"\r\n End Select\r\n Resume Next\r\nEnd Sub"
},
{
"path": "MSAccess-VCS/VCS_ImportExport.bas",
"content": "Attribute VB_Name = \"VCS_ImportExport\"\r\nOption Compare Database\r\n\r\nOption Explicit\r\n' List of lookup tables that are part of the program rather than the\r\n' data, to be exported with source code\r\n' Set to \"*\" to export the contents of all tables\r\n'Only used in ExportAllSource\r\nPrivate Const INCLUDE_TABLES As String = \"\"\r\n\r\nPrivate Const INCLUDE_TABLES_PFS As String = \"\"\r\n' This is used in ImportAllSource\r\nPrivate Const DebugOutput As Boolean = False\r\n'this is used in ExportAllSource\r\n'Causes the VCS_ code to be exported\r\nPrivate Const ArchiveMyself As Boolean = False\r\n\r\n' Export configuration\r\nPrivate Const ExportReports As Boolean = True\r\nPrivate Const ExportQueries As Boolean = True\r\nPrivate Const ExportForms As Boolean = True\r\nPrivate Const ExportMacros As Boolean = True\r\nPrivate Const ExportModules As Boolean = True\r\nPrivate Const ExportTables As Boolean = True\r\n\r\n'export/import all Queries as plain SQL text\r\nPrivate Const HandleQueriesAsSQL As Boolean = True\r\n\r\n'returns true if named module is NOT part of the VCS code\r\nPrivate Function IsNotVCS(ByVal moduleName As String) As Boolean\r\n If moduleName <> \"VCS_ImportExport\" And _\r\n moduleName <> \"VCS_IE_Functions\" And _\r\n moduleName <> \"VCS_File\" And _\r\n moduleName <> \"VCS_Dir\" And _\r\n moduleName <> \"VCS_String\" And _\r\n moduleName <> \"VCS_Loader\" And _\r\n moduleName <> \"VCS_Table\" And _\r\n moduleName <> \"VCS_Reference\" And _\r\n moduleName <> \"VCS_DataMacro\" And _\r\n moduleName <> \"VCS_Report\" And _\r\n moduleName <> \"VCS_Relation\" And _\r\n moduleName <> \"VCS_Query\" And _\r\n moduleName <> \"VCS_Button_Functions\" Then\r\n IsNotVCS = True\r\n Else\r\n IsNotVCS = False\r\n End If\r\n\r\nEnd Function\r\n\r\n' Main entry point for EXPORT. Export all forms, reports, queries,\r\n' macros, modules, and lookup tables to `source` folder under the\r\n' database's folder.\r\nPublic Sub ExportAllSource(Optional ByVal isButton As Boolean)\r\n Dim Db As Object ' DAO.Database\r\n Dim source_path As String\r\n Dim source_path_pfs As String\r\n Dim obj_path As String\r\n Dim qry As Object ' DAO.QueryDef\r\n Dim doc As Object ' DAO.Document\r\n Dim obj_type As Variant\r\n Dim obj_type_split() As String\r\n Dim obj_type_label As String\r\n Dim obj_type_name As String\r\n Dim obj_type_num As Integer\r\n Dim obj_count As Integer\r\n Dim obj_data_count As Integer\r\n Dim ucs2 As Boolean\r\n Dim ExportTablesTemp As Boolean\r\n\r\n Set Db = CurrentDb\r\n \r\n If isButton = True Then\r\n ExportTablesTemp = False\r\n Else\r\n ExportTablesTemp = ExportTables\r\n End If\r\n \r\n \r\n\r\n CloseFormsReports\r\n 'InitVCS_UsingUcs2\r\n\r\n source_path = VCS_Dir.VCS_ProjectPath() & \"source\\\"\r\n source_path_pfs = VCS_Dir.VCS_ProjectPath() & \"pfs\\\"\r\n VCS_Dir.VCS_MkDirIfNotExist source_path\r\n\r\n Debug.Print\r\n\r\n If ExportQueries Then\r\n obj_path = source_path & \"queries\\\"\r\n VCS_Dir.VCS_ClearTextFilesFromDir obj_path, \"bas\"\r\n Debug.Print VCS_String.VCS_PadRight(\"Exporting queries...\", 24);\r\n obj_count = 0\r\n For Each qry In Db.QueryDefs\r\n DoEvents\r\n If Left$(qry.Name, 1) <> \"~\" Then\r\n If HandleQueriesAsSQL Then\r\n VCS_Query.ExportQueryAsSQL qry, obj_path & qry.Name & \".bas\", False\r\n Else\r\n VCS_IE_Functions.VCS_ExportObject acQuery, qry.Name, obj_path & qry.Name & \".bas\", VCS_File.VCS_UsingUcs2\r\n End If\r\n obj_count = obj_count + 1\r\n End If\r\n Next\r\n Debug.Print VCS_String.VCS_PadRight(\"Sanitizing...\", 15);\r\n VCS_IE_Functions.VCS_SanitizeTextFiles obj_path, \"bas\"\r\n Debug.Print \"[\" & obj_count & \"]\"\r\n End If\r\n\r\n \r\n For Each obj_type In Split( _\r\n \"forms|Forms|\" & acForm & \",\" & _\r\n \"reports|Reports|\" & acReport & \",\" & _\r\n \"macros|Scripts|\" & acMacro & \",\" & _\r\n \"modules|Modules|\" & acModule _\r\n , \",\" _\r\n )\r\n obj_type_split = Split(obj_type, \"|\")\r\n obj_type_label = obj_type_split(0)\r\n obj_type_name = obj_type_split(1)\r\n obj_type_num = Val(obj_type_split(2))\r\n obj_path = source_path & obj_type_label & \"\\\"\r\n obj_count = 0\r\n \r\n If (obj_type_label = \"forms\" And ExportForms) _\r\n Or (obj_type_label = \"reports\" And ExportReports) _\r\n Or (obj_type_label = \"macros\" And ExportMacros) _\r\n Or (obj_type_label = \"modules\" And ExportModules) Then\r\n \r\n VCS_Dir.VCS_ClearTextFilesFromDir obj_path, \"bas\"\r\n Debug.Print VCS_String.VCS_PadRight(\"Exporting \" & obj_type_label & \"...\", 24);\r\n For Each doc In Db.Containers(obj_type_name).Documents\r\n DoEvents\r\n If (Left$(doc.Name, 1) <> \"~\") And _\r\n (IsNotVCS(doc.Name) Or ArchiveMyself) Then\r\n If obj_type_label = \"modules\" Then\r\n ucs2 = False\r\n Else\r\n ucs2 = VCS_File.VCS_UsingUcs2\r\n End If\r\n VCS_IE_Functions.VCS_ExportObject obj_type_num, doc.Name, obj_path & doc.Name & \".bas\", ucs2\r\n \r\n If obj_type_label = \"reports\" Then\r\n VCS_Report.VCS_ExportPrintVars doc.Name, obj_path & doc.Name & \".pv\"\r\n End If\r\n \r\n obj_count = obj_count + 1\r\n End If\r\n Next\r\n\r\n Debug.Print VCS_String.VCS_PadRight(\"Sanitizing...\", 15);\r\n If obj_type_label <> \"modules\" Then\r\n VCS_IE_Functions.VCS_SanitizeTextFiles obj_path, \"bas\"\r\n End If\r\n Debug.Print \"[\" & obj_count & \"]\"\r\n End If\r\n Next\r\n \r\n VCS_Reference.VCS_ExportReferences source_path\r\n\r\n'-------------------------table export------------------------\r\n If ExportTablesTemp Then\r\n obj_path = source_path & \"tables\\\"\r\n VCS_Dir.VCS_MkDirIfNotExist Left$(obj_path, InStrRev(obj_path, \"\\\"))\r\n VCS_Dir.VCS_ClearTextFilesFromDir obj_path, \"txt\"\r\n \r\n Dim td As DAO.TableDef\r\n Dim tds As DAO.TableDefs\r\n Set tds = Db.TableDefs\r\n\r\n obj_type_label = \"tbldef\"\r\n obj_type_name = \"Table_Def\"\r\n obj_type_num = acTable\r\n obj_path = source_path & obj_type_label & \"\\\"\r\n obj_count = 0\r\n obj_data_count = 0\r\n VCS_Dir.VCS_MkDirIfNotExist Left$(obj_path, InStrRev(obj_path, \"\\\"))\r\n \r\n 'move these into Table and DataMacro modules?\r\n ' - We don't want to determin file extensions here - or obj_path either!\r\n VCS_Dir.VCS_ClearTextFilesFromDir obj_path, \"sql\"\r\n VCS_Dir.VCS_ClearTextFilesFromDir obj_path, \"xml\"\r\n VCS_Dir.VCS_ClearTextFilesFromDir obj_path, \"LNKD\"\r\n \r\n Dim IncludeTablesCol As Collection\r\n Set IncludeTablesCol = StrSetToCol(INCLUDE_TABLES, \",\")\r\n \r\n Debug.Print VCS_String.VCS_PadRight(\"Exporting \" & obj_type_label & \"...\", 24);\r\n \r\n For Each td In tds\r\n ' This is not a system table\r\n ' this is not a temporary table\r\n If Left$(td.Name, 4) <> \"MSys\" And _\r\n Left$(td.Name, 1) <> \"~\" Then\r\n If Len(td.connect) = 0 Then ' this is not an external table\r\n VCS_Table.VCS_ExportTableDef td.Name, obj_path\r\n If INCLUDE_TABLES = \"*\" Then\r\n DoEvents\r\n VCS_Table.VCS_ExportTableData CStr(td.Name), source_path & \"tables\\\"\r\n If Len(Dir$(source_path & \"tables\\\" & td.Name & \".txt\")) > 0 Then\r\n obj_data_count = obj_data_count + 1\r\n End If\r\n ElseIf (Len(Replace(INCLUDE_TABLES, \" \", vbNullString)) > 0) And INCLUDE_TABLES <> \"*\" Then\r\n DoEvents\r\n On Error GoTo Err_TableNotFound\r\n If InCollection(IncludeTablesCol, td.Name) Then\r\n VCS_Table.VCS_ExportTableData CStr(td.Name), source_path & \"tables\\\"\r\n obj_data_count = obj_data_count + 1\r\n End If\r\nErr_TableNotFound:\r\n \r\n 'else don't export table data\r\n End If\r\n Else\r\n VCS_Table.VCS_ExportLinkedTable td.Name, obj_path\r\n End If\r\n \r\n obj_count = obj_count + 1\r\n \r\n End If\r\n Next\r\n Debug.Print \"[\" & obj_count & \"]\"\r\n If obj_data_count > 0 Then\r\n Debug.Print VCS_String.VCS_PadRight(\"Exported data...\", 24) & \"[\" & obj_data_count & \"]\"\r\n End If\r\n \r\n Set IncludeTablesCol = StrSetToCol(INCLUDE_TABLES_PFS, \",\")\r\n \r\n Debug.Print VCS_String.VCS_PadRight(\"Exporting \" & obj_type_label & \"...\", 24);\r\n \r\n For Each td In tds\r\n ' This is not a system table\r\n ' this is not a temporary table\r\n If Left$(td.Name, 4) <> \"MSys\" And _\r\n Left$(td.Name, 1) <> \"~\" Then\r\n If Len(td.connect) = 0 Then ' this is not an external table\r\n VCS_Table.VCS_ExportTableDef td.Name, obj_path\r\n If INCLUDE_TABLES = \"*\" Then\r\n DoEvents\r\n VCS_Table.VCS_ExportTableData CStr(td.Name), source_path_pfs & \"tables\\\"\r\n If Len(Dir$(source_path_pfs & \"tables\\\" & td.Name & \".txt\")) > 0 Then\r\n obj_data_count = obj_data_count + 1\r\n End If\r\n ElseIf (Len(Replace(INCLUDE_TABLES, \" \", vbNullString)) > 0) And INCLUDE_TABLES <> \"*\" Then\r\n DoEvents\r\n On Error GoTo Err_TablePFSNotFound\r\n If InCollection(IncludeTablesCol, td.Name) Then\r\n VCS_Table.VCS_ExportTableData CStr(td.Name), source_path_pfs & \"tables\\\"\r\n obj_data_count = obj_data_count + 1\r\n End If\r\nErr_TablePFSNotFound:\r\n \r\n 'else don't export table data\r\n End If\r\n Else\r\n VCS_Table.VCS_ExportLinkedTable td.Name, obj_path\r\n End If\r\n \r\n obj_count = obj_count + 1\r\n \r\n End If\r\n Next\r\n Debug.Print \"[\" & obj_count & \"]\"\r\n If obj_data_count > 0 Then\r\n Debug.Print VCS_String.VCS_PadRight(\"Exported data...\", 24) & \"[\" & obj_data_count & \"]\"\r\n End If\r\n \r\n \r\n Debug.Print VCS_String.VCS_PadRight(\"Exporting Relations...\", 24);\r\n obj_count = 0\r\n obj_path = source_path & \"relations\\\"\r\n VCS_Dir.VCS_MkDirIfNotExist Left$(obj_path, InStrRev(obj_path, \"\\\"))\r\n\r\n VCS_Dir.VCS_ClearTextFilesFromDir obj_path, \"txt\"\r\n\r\n Dim aRelation As DAO.Relation\r\n \r\n For Each aRelation In CurrentDb.Relations\r\n ' Exclude relations from system tables and inherited (linked) relations\r\n ' Skip if dbRelationDontEnforce property is not set. The relationship is already in the table xml file. - sean\r\n If Not (aRelation.Name = \"MSysNavPaneGroupsMSysNavPaneGroupToObjects\" _\r\n Or aRelation.Name = \"MSysNavPaneGroupCategoriesMSysNavPaneGroups\" _\r\n Or (aRelation.Attributes And DAO.RelationAttributeEnum.dbRelationInherited) = _\r\n DAO.RelationAttributeEnum.dbRelationInherited) _\r\n And ((aRelation.Attributes And DAO.RelationAttributeEnum.dbRelationDontEnforce) = _\r\n\t\t\t \t\tDAO.RelationAttributeEnum.dbRelationDontEnforce) Then\r\n VCS_Relation.VCS_ExportRelation aRelation, obj_path & aRelation.Name & \".txt\"\r\n obj_count = obj_count + 1\r\n End If\r\n Next\r\n Debug.Print \"[\" & obj_count & \"]\"\r\n End If\r\n \r\n Debug.Print \"Done.\"\r\nEnd Sub\r\n\r\n\r\n' Main entry point for IMPORT. Import all forms, reports, queries,\r\n' macros, modules, and lookup tables from `source` folder under the\r\n' database's folder.\r\nPublic Sub ImportAllSource(Optional ByVal isButton As Boolean)\r\n Dim FSO As Object\r\n Dim source_path As String\r\n Dim obj_path As String\r\n Dim obj_type As Variant\r\n Dim obj_type_split() As String\r\n Dim obj_type_label As String\r\n Dim obj_type_num As Integer\r\n Dim obj_count As Integer\r\n Dim fileName As String\r\n Dim obj_name As String\r\n Dim ucs2 As Boolean\r\n \r\n Dim includeTables As Boolean\r\n \r\n If isButton = True Then\r\n includeTables = False\r\n Else\r\n includeTables = True\r\n End If\r\n\r\n Set FSO = CreateObject(\"Scripting.FileSystemObject\")\r\n\r\n CloseFormsReports\r\n 'InitVCS_UsingUcs2\r\n\r\n source_path = VCS_Dir.VCS_ProjectPath() & \"source\\\"\r\n If Not FSO.FolderExists(source_path) Then\r\n MsgBox \"No source found at:\" & vbCrLf & source_path, vbExclamation, \"Import failed\"\r\n Exit Sub\r\n End If\r\n\r\n Debug.Print\r\n \r\n If Not VCS_Reference.VCS_ImportReferences(source_path) Then\r\n Debug.Print \"Info: no references file in \" & source_path\r\n Debug.Print\r\n End If\r\n\r\n obj_path = source_path & \"queries\\\"\r\n fileName = Dir$(obj_path & \"*.bas\")\r\n \r\n Dim tempFilePath As String\r\n tempFilePath = VCS_File.VCS_TempFile()\r\n \r\n If Len(fileName) > 0 Then\r\n Debug.Print VCS_String.VCS_PadRight(\"Importing queries...\", 24);\r\n obj_count = 0\r\n Do Until Len(fileName) = 0\r\n DoEvents\r\n obj_name = Mid$(fileName, 1, InStrRev(fileName, \".\") - 1)\r\n 'Check for plain sql export/import\r\n If HandleQueriesAsSQL Then\r\n VCS_Query.ImportQueryFromSQL obj_name, obj_path & fileName, False\r\n Else\r\n VCS_IE_Functions.VCS_ImportObject acQuery, obj_name, obj_path & fileName, VCS_File.VCS_UsingUcs2\r\n VCS_IE_Functions.VCS_ExportObject acQuery, obj_name, tempFilePath, VCS_File.VCS_UsingUcs2\r\n VCS_IE_Functions.VCS_ImportObject acQuery, obj_name, tempFilePath, VCS_File.VCS_UsingUcs2\r\n End If\r\n obj_count = obj_count + 1\r\n fileName = Dir$()\r\n Loop\r\n Debug.Print \"[\" & obj_count & \"]\"\r\n End If\r\n \r\n VCS_Dir.VCS_DelIfExist tempFilePath\r\n\r\n If includeTables = True Then\r\n ' restore table definitions\r\n obj_path = source_path & \"tbldef\\\"\r\n fileName = Dir$(obj_path & \"*.xml\")\r\n If Len(fileName) > 0 Then\r\n Debug.Print VCS_String.VCS_PadRight(\"Importing tabledefs...\", 24);\r\n obj_count = 0\r\n Do Until Len(fileName) = 0\r\n obj_name = Mid$(fileName, 1, InStrRev(fileName, \".\") - 1)\r\n If DebugOutput Then\r\n If obj_count = 0 Then\r\n Debug.Print\r\n End If\r\n Debug.Print \" [debug] table \" & obj_name;\r\n Debug.Print\r\n End If\r\n VCS_Table.VCS_ImportTableDef CStr(obj_name), obj_path\r\n obj_count = obj_count + 1\r\n fileName = Dir$()\r\n Loop\r\n Debug.Print \"[\" & obj_count & \"]\"\r\n End If\r\n \r\n \r\n ' restore linked tables - we must have access to the remote store to import these!\r\n fileName = Dir$(obj_path & \"*.LNKD\")\r\n If Len(fileName) > 0 Then\r\n Debug.Print VCS_String.VCS_PadRight(\"Importing Linked tabledefs...\", 24);\r\n obj_count = 0\r\n Do Until Len(fileName) = 0\r\n obj_name = Mid$(fileName, 1, InStrRev(fileName, \".\") - 1)\r\n If DebugOutput Then\r\n If obj_count = 0 Then\r\n Debug.Print\r\n End If\r\n Debug.Print \" [debug] table \" & obj_name;\r\n Debug.Print\r\n End If\r\n VCS_Table.VCS_ImportLinkedTable CStr(obj_name), obj_path\r\n obj_count = obj_count + 1\r\n fileName = Dir$()\r\n Loop\r\n Debug.Print \"[\" & obj_count & \"]\"\r\n End If\r\n \r\n \r\n \r\n ' NOW we may load data\r\n obj_path = source_path & \"tables\\\"\r\n fileName = Dir$(obj_path & \"*.txt\")\r\n \r\n If Len(fileName) > 0 Then\r\n Debug.Print VCS_String.VCS_PadRight(\"Importing tables...\", 24);\r\n obj_count = 0\r\n Do Until Len(fileName) = 0\r\n DoEvents\r\n obj_name = Mid$(fileName, 1, InStrRev(fileName, \".\") - 1)\r\n VCS_Table.VCS_ImportTableData CStr(obj_name), obj_path\r\n obj_count = obj_count + 1\r\n fileName = Dir$()\r\n Loop\r\n Debug.Print \"[\" & obj_count & \"]\"\r\n End If\r\n \r\n \r\n \r\n ' load data for pfs\r\n \r\n 'load Data Macros - not DRY!\r\n obj_path = source_path & \"tbldef\\\"\r\n fileName = Dir$(obj_path & \"*.dm\")\r\n If Len(fileName) > 0 Then\r\n Debug.Print VCS_String.VCS_PadRight(\"Importing Data Macros...\", 24);\r\n obj_count = 0\r\n Do Until Len(fileName) = 0\r\n DoEvents\r\n obj_name = Mid$(fileName, 1, InStrRev(fileName, \".\") - 1)\r\n 'VCS_Table.VCS_ImportTableData CStr(obj_name), obj_path\r\n VCS_DataMacro.VCS_ImportDataMacros obj_name, obj_path\r\n obj_count = obj_count + 1\r\n fileName = Dir$()\r\n Loop\r\n Debug.Print \"[\" & obj_count & \"]\"\r\n End If\r\n End If\r\n \r\n \r\n\r\n 'import Data Macros\r\n \r\n\r\n For Each obj_type In Split( _\r\n \"forms|\" & acForm & \",\" & _\r\n \"reports|\" & acReport & \",\" & _\r\n \"macros|\" & acMacro & \",\" & _\r\n \"modules|\" & acModule _\r\n , \",\" _\r\n )\r\n obj_type_split = Split(obj_type, \"|\")\r\n obj_type_label = obj_type_split(0)\r\n obj_type_num = Val(obj_type_split(1))\r\n obj_path = source_path & obj_type_label & \"\\\"\r\n \r\n \r\n fileName = Dir$(obj_path & \"*.bas\")\r\n If Len(fileName) > 0 Then\r\n Debug.Print VCS_String.VCS_PadRight(\"Importing \" & obj_type_label & \"...\", 24);\r\n obj_count = 0\r\n Do Until Len(fileName) = 0\r\n ' DoEvents no good idea!\r\n obj_name = Mid$(fileName, 1, InStrRev(fileName, \".\") - 1)\r\n If obj_type_label = \"modules\" Then\r\n ucs2 = False\r\n Else\r\n ucs2 = VCS_File.VCS_UsingUcs2\r\n End If\r\n If IsNotVCS(obj_name) Then\r\n VCS_IE_Functions.VCS_ImportObject obj_type_num, obj_name, obj_path & fileName, ucs2\r\n obj_count = obj_count + 1\r\n Else\r\n If ArchiveMyself Then\r\n MsgBox \"Module \" & obj_name & \" could not be updated while running. Ensure latest version is included!\", vbExclamation, \"Warning\"\r\n End If\r\n End If\r\n fileName = Dir$()\r\n Loop\r\n Debug.Print \"[\" & obj_count & \"]\"\r\n \r\n End If\r\n Next\r\n \r\n 'import Print Variables\r\n Debug.Print VCS_String.VCS_PadRight(\"Importing Print Vars...\", 24);\r\n obj_count = 0\r\n \r\n obj_path = source_path & \"reports\\\"\r\n fileName = Dir$(obj_path & \"*.pv\")\r\n Do Until Len(fileName) = 0\r\n DoEvents\r\n obj_name = Mid$(fileName, 1, InStrRev(fileName, \".\") - 1)\r\n VCS_Report.VCS_ImportPrintVars obj_name, obj_path & fileName\r\n obj_count = obj_count + 1\r\n fileName = Dir$()\r\n Loop\r\n Debug.Print \"[\" & obj_count & \"]\"\r\n \r\n If includeTables = True Then\r\n 'import relations\r\n Debug.Print VCS_String.VCS_PadRight(\"Importing Relations...\", 24);\r\n obj_count = 0\r\n obj_path = source_path & \"relations\\\"\r\n fileName = Dir$(obj_path & \"*.txt\")\r\n Do Until Len(fileName) = 0\r\n DoEvents\r\n VCS_Relation.VCS_ImportRelation obj_path & fileName\r\n obj_count = obj_count + 1\r\n fileName = Dir$()\r\n Loop\r\n Debug.Print \"[\" & obj_count & \"]\"\r\n End If\r\n DoEvents\r\n \r\n Debug.Print \"Done.\"\r\nEnd Sub\r\n\r\n' Main entry point for ImportProject.\r\n' Drop all forms, reports, queries, macros, modules.\r\n' execute ImportAllSource.\r\nPublic Sub ImportProject(Optional ByVal isButton As Boolean)\r\n On Error GoTo ErrorHandler\r\n\r\n Dim includeTables As Boolean\r\n \r\n If isButton = True Then\r\n includeTables = False\r\n Else\r\n includeTables = True\r\n End If\r\n \r\n If MsgBox(\"This action will delete all existing: \" & vbCrLf & _\r\n vbCrLf & _\r\n IIf(includeTables, Chr$(149) & \" Tables\" & vbCrLf, \"\") & _\r\n Chr$(149) & \" Forms\" & vbCrLf & _\r\n Chr$(149) & \" Macros\" & vbCrLf & _\r\n Chr$(149) & \" Modules\" & vbCrLf & _\r\n Chr$(149) & \" Queries\" & vbCrLf & _\r\n Chr$(149) & \" Reports\" & vbCrLf & _\r\n vbCrLf & _\r\n \"Are you sure you want to proceed?\", vbCritical + vbYesNo, _\r\n \"Import Project\") <> vbYes Then\r\n Exit Sub\r\n End If\r\n\r\n Dim Db As DAO.Database\r\n Set Db = CurrentDb\r\n CloseFormsReports\r\n\r\n Debug.Print\r\n Debug.Print \"Deleting Existing Objects\"\r\n Debug.Print\r\n \r\n ' only delete tables & relations if var is true\r\n If includeTables = True Then\r\n Debug.Print \"Deleting table relations\"\r\n Dim rel As DAO.Relation\r\n For Each rel In CurrentDb.Relations\r\n If Not (rel.Name = \"MSysNavPaneGroupsMSysNavPaneGroupToObjects\" Or _\r\n rel.Name = \"MSysNavPaneGroupCategoriesMSysNavPaneGroups\") Then\r\n CurrentDb.Relations.Delete (rel.Name)\r\n End If\r\n Next\r\n End If\r\n \r\n ' First gather all Query Names.\r\n ' If you delete right away, the iterator loses track and only deletes every 2nd Query\r\n Dim toBeDeleted As Collection\r\n Set toBeDeleted = New Collection\r\n Dim qryName As Variant\r\n \r\n Debug.Print \"Deleting queries\"\r\n Dim dbObject As Object\r\n For Each dbObject In Db.QueryDefs\r\n DoEvents\r\n If Left$(dbObject.Name, 1) <> \"~\" Then\r\n toBeDeleted.Add dbObject.Name\r\n End If\r\n Next\r\n\r\n \r\n For Each qryName In toBeDeleted\r\n Db.QueryDefs.Delete qryName\r\n Next\r\n \r\n Set toBeDeleted = Nothing\r\n If includeTables = True Then\r\n Debug.Print \"Deleting table defs\"\r\n Dim td As DAO.TableDef\r\n For Each td In CurrentDb.TableDefs\r\n If Left$(td.Name, 4) <> \"MSys\" And _\r\n Left$(td.Name, 1) <> \"~\" Then\r\n CurrentDb.TableDefs.Delete (td.Name)\r\n End If\r\n Next\r\n End If\r\n\r\n Dim objType As Variant\r\n Dim objTypeArray() As String\r\n Dim doc As Object\r\n '\r\n ' Object Type Constants\r\n Const OTNAME As Byte = 0\r\n Const OTID As Byte = 1\r\n\r\n For Each objType In Split( _\r\n \"Forms|\" & acForm & \",\" & _\r\n \"Reports|\" & acReport & \",\" & _\r\n \"Scripts|\" & acMacro & \",\" & _\r\n \"Modules|\" & acModule _\r\n , \",\" _\r\n )\r\n objTypeArray = Split(objType, \"|\")\r\n DoEvents\r\n For Each doc In Db.Containers(objTypeArray(OTNAME)).Documents\r\n DoEvents\r\n If (Left$(doc.Name, 1) <> \"~\") And _\r\n (IsNotVCS(doc.Name)) Then\r\n' Debug.Print doc.Name\r\n DoCmd.DeleteObject objTypeArray(OTID), doc.Name\r\n End If\r\n Next\r\n Next\r\n \r\n Debug.Print \"=================\"\r\n Debug.Print \"Importing Project\"\r\n ImportAllSource (isButton)\r\n \r\n Exit Sub\r\n\r\nErrorHandler:\r\n Debug.Print \"VCS_ImportExport.ImportProject: Error #\" & Err.Number & vbCrLf & _\r\n Err.Description\r\nEnd Sub\r\n\r\n\r\n'===================================================================================================================================\r\n'-----------------------------------------------------------'\r\n' Helper Functions - these should be put in their own files '\r\n'-----------------------------------------------------------'\r\n\r\n' Close all open forms.\r\nPrivate Sub CloseFormsReports()\r\n On Error GoTo ErrorHandler\r\n Do While Forms.Count > 0\r\n DoCmd.Close acForm, Forms(0).Name\r\n DoEvents\r\n Loop\r\n Do While Reports.Count > 0\r\n DoCmd.Close acReport, Reports(0).Name\r\n DoEvents\r\n Loop\r\n Exit Sub\r\n\r\nErrorHandler:\r\n Debug.Print \"VCS_ImportExport.CloseFormsReports: Error #\" & Err.Number & vbCrLf & _\r\n Err.Description\r\nEnd Sub\r\n\r\n\r\n'errno 457 - duplicate key (& item)\r\nPrivate Function StrSetToCol(ByVal strSet As String, ByVal delimiter As String) As Collection 'throws errors\r\n Dim strSetArray() As String\r\n Dim col As Collection\r\n \r\n Set col = New Collection\r\n strSetArray = Split(strSet, delimiter)\r\n \r\n Dim strPart As Variant\r\n For Each strPart In strSetArray\r\n col.Add strPart, strPart\r\n Next\r\n \r\n Set StrSetToCol = col\r\nEnd Function\r\n\r\n\r\n' Check if an item or key is in a collection\r\nPrivate Function InCollection(col As Collection, Optional vItem, Optional vKey) As Boolean\r\n On Error Resume Next\r\n\r\n Dim vColItem As Variant\r\n\r\n InCollection = False\r\n\r\n If Not IsMissing(vKey) Then\r\n col.Item vKey\r\n\r\n '5 if not in collection, it is 91 if no collection exists\r\n If Err.Number <> 5 And Err.Number <> 91 Then\r\n InCollection = True\r\n End If\r\n ElseIf Not IsMissing(vItem) Then\r\n For Each vColItem In col\r\n If vColItem = vItem Then\r\n InCollection = True\r\n GoTo Exit_Proc\r\n End If\r\n Next vColItem\r\n End If\r\n\r\nExit_Proc:\r\n Exit Function\r\nErr_Handle:\r\n Resume Exit_Proc\r\nEnd Function\r\n\r\n\r\n\r\n\r\n\r\n\r\n"
},
{
"path": "MSAccess-VCS/VCS_Query.bas",
"content": "Attribute VB_Name = \"VCS_Query\"\r\nOption Compare Database\r\nOption Explicit\r\n\r\nConst StartConnect As String = \"[CONNECT]\"\r\nConst StartSQL As String = \"[SQL]\"\r\nConst StartRecRecords As String = \"[ReturnRecs]\"\r\n\r\nPublic Sub ExportQueryAsSQL(qry As QueryDef, ByVal file_path As String, _\r\n Optional ByVal Ucs2Convert As Boolean = False)\r\n\r\n VCS_Dir.VCS_MkDirIfNotExist Left$(file_path, InStrRev(file_path, \"\\\"))\r\n If Ucs2Convert Then\r\n Dim tempFileName As String\r\n tempFileName = VCS_File.VCS_TempFile()\r\n writeTextToFile qry.sql, tempFileName\r\n VCS_File.VCS_ConvertUcs2Utf8 tempFileName, file_path\r\n Else\r\n If Not (qry.connect = \"\") Then\r\n Dim qryconnect As String\r\n qryconnect = qry.connect\r\n If (Right(qryconnect, 1) = vbLf) Then\r\n qryconnect = Left(qryconnect, Len(qryconnect) - 2)\r\n End If\r\n writeTextToFile StartConnect & qryconnect & vbCrLf & StartRecRecords & qry.ReturnsRecords & vbCrLf & StartSQL & vbCrLf & qry.sql, file_path\r\n Else\r\n writeTextToFile qry.sql, file_path\r\n End If\r\n End If\r\n\r\nEnd Sub\r\n\r\nPrivate Sub writeTextToFile(ByVal textToWrite As String, ByVal file_path As String)\r\n \r\n Dim fso As Object\r\n Set fso = CreateObject(\"Scripting.FileSystemObject\")\r\n Dim oFile As Object\r\n Set oFile = fso.CreateTextFile(file_path)\r\n\r\n oFile.WriteLine textToWrite\r\n oFile.Close\r\n \r\n Set fso = Nothing\r\n Set oFile = Nothing\r\n\r\nEnd Sub\r\n\r\nPrivate Function readFromTextFile(ByVal file_path As String) As String\r\n Dim textRead As String\r\n Dim fso As Object\r\n Set fso = CreateObject(\"Scripting.FileSystemObject\")\r\n Dim oFile As Object\r\n Set oFile = fso.OpenTextFile(file_path, ForReading)\r\n\r\n Do While Not oFile.AtEndOfStream\r\n textRead = textRead & oFile.ReadLine & vbCrLf\r\n Loop\r\n\r\n readFromTextFile = textRead\r\n \r\n oFile.Close\r\n \r\n Set fso = Nothing\r\n Set oFile = Nothing\r\n\r\nEnd Function\r\n\r\nPublic Sub ImportQueryFromSQL(ByVal obj_name As String, ByVal file_path As String, _\r\n Optional ByVal Ucs2Convert As Boolean = False)\r\nDim db As DAO.Database\r\nDim qdf As DAO.QueryDef\r\n\r\n If Not VCS_Dir.VCS_FileExists(file_path) Then Exit Sub\r\n Set db = CurrentDb\r\n \r\n If Ucs2Convert Then\r\n \r\n Dim tempFileName As String\r\n tempFileName = VCS_File.VCS_TempFile()\r\n VCS_File.VCS_ConvertUtf8Ucs2 file_path, tempFileName\r\n On Error Resume Next\r\n db.QueryDefs.Delete (obj_name)\r\n db.CreateQueryDef obj_name, readFromTextFile(file_path)\r\n \r\n Dim fso As Object\r\n Set fso = CreateObject(\"Scripting.FileSystemObject\")\r\n fso.DeleteFile tempFileName\r\n Else\r\n Dim fileStr As String\r\n Dim ConnectString As String\r\n Dim SQLString As String\r\n Dim SQLPosition As Integer\r\n Dim retrecpos As Integer\r\n Dim retrecstr As String\r\n Dim retrec As Boolean\r\n 'normally, queries are going to reurn records, so set to true in case it's not defined.\r\n retrec = True\r\n\r\n fileStr = readFromTextFile(file_path)\r\n 'find out if there's a connect string or other stuff. If there is, the SQL position will be greater than 0\r\n SQLPosition = InStr(1, fileStr, StartSQL, vbBinaryCompare)\r\n \r\n If SQLPosition > 0 Then\r\n retrecpos = InStr(1, fileStr, StartRecRecords, vbBinaryCompare)\r\n retrecstr = mid(fileStr, retrecpos + Len(StartRecRecords), 1)\r\n ConnectString = mid(fileStr, 10, retrecpos - 11)\r\n 'find the start of the SQL, plus two charachters (carriage return + line feed = vbcrlf)\r\n SQLString = mid(fileStr, SQLPosition + Len(StartSQL) + 2)\r\n\r\n Select Case retrecstr\r\n Case \"f\", \"F\", \"0\"\r\n retrec = False\r\n Case \"T\", \"t\", \"1\"\r\n retrec = True\r\n End Select\r\n \r\n On Error Resume Next\r\n DoCmd.DeleteObject acQuery, obj_name\r\n Set qdf = db.CreateQueryDef(obj_name)\r\n Set qdf = db.QueryDefs(obj_name)\r\n With qdf\r\n .connect = ConnectString\r\n .ReturnsRecords = retrec\r\n .SQL = SQLString\r\n End With\r\n Else\r\n On Error Resume Next\r\n DoCmd.DeleteObject acQuery, obj_name\r\n Set qdf = db.CreateQueryDef(obj_name, fileStr)\r\n End If\r\n\r\n End If\r\n qdf.Close\r\n Set qdf = Nothing\r\n Set db = Nothing\r\nEnd Sub\r\n"
},
{
"path": "MSAccess-VCS/VCS_Reference.bas",
"content": "Attribute VB_Name = \"VCS_Reference\"\r\nOption Compare Database\r\n\r\nOption Private Module\r\nOption Explicit\r\n\r\n\r\n' Import References from a CSV, true=SUCCESS\r\nPublic Function VCS_ImportReferences(ByVal obj_path As String) As Boolean\r\n Dim FSO As Object\r\n Dim InFile As Object\r\n Dim line As String\r\n Dim strParts() As String\r\n Dim GUID As String\r\n Dim Major As Long\r\n Dim Minor As Long\r\n Dim fileName As String\r\n Dim refName As String\r\n \r\n fileName = Dir$(obj_path & \"references.csv\")\r\n If Len(fileName) = 0 Then\r\n VCS_ImportReferences = False\r\n Exit Function\r\n End If\r\n Set FSO = CreateObject(\"Scripting.FileSystemObject\")\r\n Set InFile = FSO.OpenTextFile(obj_path & fileName, iomode:=ForReading, create:=False, Format:=TristateFalse)\r\n \r\nOn Error GoTo failed_guid\r\n Do Until InFile.AtEndOfStream\r\n line = InFile.ReadLine\r\n strParts = Split(line, \",\")\r\n If UBound(strParts) = 2 Then 'a ref with a guid\r\n GUID = Trim$(strParts(0))\r\n Major = CLng(strParts(1))\r\n Minor = CLng(strParts(2))\r\n Application.References.AddFromGuid GUID, Major, Minor\r\n Else\r\n refName = Trim$(strParts(0))\r\n Application.References.AddFromFile refName\r\n End If\r\ngo_on:\r\n Loop\r\nOn Error GoTo 0\r\n InFile.Close\r\n Set InFile = Nothing\r\n Set FSO = Nothing\r\n VCS_ImportReferences = True\r\n Exit Function\r\n \r\nfailed_guid:\r\n If Err.Number = 32813 Then\r\n 'The reference is already present in the access project - so we can ignore the error\r\n Resume Next\r\n Else\r\n MsgBox \"Failed to register \" & GUID, , \"Error: \" & Err.Number\r\n 'Do we really want to carry on the import with missing references??? - Surely this is fatal\r\n Resume go_on\r\n End If\r\n \r\nEnd Function\r\n\r\n' Export References to a CSV\r\nPublic Sub VCS_ExportReferences(ByVal obj_path As String)\r\n Dim FSO As Object\r\n Dim OutFile As Object\r\n Dim line As String\r\n Dim ref As Reference\r\n\r\n Set FSO = CreateObject(\"Scripting.FileSystemObject\")\r\n Set OutFile = FSO.CreateTextFile(obj_path & \"references.csv\", overwrite:=True, Unicode:=False)\r\n For Each ref In Application.References\r\n If ref.GUID <> vbNullString Then ' references of types mdb,accdb,mde etc don't have a GUID\r\n If Not ref.BuiltIn Then\r\n line = ref.GUID & \",\" & CStr(ref.Major) & \",\" & CStr(ref.Minor)\r\n OutFile.WriteLine line\r\n End If\r\n Else\r\n line = ref.FullPath\r\n OutFile.WriteLine line\r\n End If\r\n Next\r\n OutFile.Close\r\nEnd Sub"
},
{
"path": "MSAccess-VCS/VCS_Relation.bas",
"content": "Attribute VB_Name = \"VCS_Relation\"\r\nOption Compare Database\r\n\r\nOption Private Module\r\nOption Explicit\r\n\r\n\r\nPublic Sub VCS_ExportRelation(ByVal rel As DAO.Relation, ByVal filePath As String)\r\n Dim FSO As Object\r\n Dim OutFile As Object\r\n Set FSO = CreateObject(\"Scripting.FileSystemObject\")\r\n Set OutFile = FSO.CreateTextFile(filePath, overwrite:=True, Unicode:=False)\r\n\r\n OutFile.WriteLine rel.Attributes 'RelationAttributeEnum\r\n OutFile.WriteLine rel.Name\r\n OutFile.WriteLine rel.table\r\n OutFile.WriteLine rel.foreignTable\r\n \r\n Dim f As DAO.Field\r\n For Each f In rel.Fields\r\n OutFile.WriteLine \"Field = Begin\"\r\n OutFile.WriteLine f.Name\r\n OutFile.WriteLine f.ForeignName\r\n OutFile.WriteLine \"End\"\r\n Next\r\n \r\n OutFile.Close\r\n\r\nEnd Sub\r\n\r\nPublic Sub VCS_ImportRelation(ByVal filePath As String)\r\n Dim FSO As Object\r\n Dim InFile As Object\r\n Set FSO = CreateObject(\"Scripting.FileSystemObject\")\r\n Set InFile = FSO.OpenTextFile(filePath, iomode:=ForReading, create:=False, Format:=TristateFalse)\r\n Dim rel As DAO.Relation\r\n Set rel = New DAO.Relation\r\n \r\n rel.Attributes = InFile.ReadLine\r\n rel.Name = InFile.ReadLine\r\n rel.table = InFile.ReadLine\r\n rel.foreignTable = InFile.ReadLine\r\n \r\n Dim f As DAO.Field\r\n Do Until InFile.AtEndOfStream\r\n If \"Field = Begin\" = InFile.ReadLine Then\r\n Set f = New DAO.Field\r\n f.Name = InFile.ReadLine\r\n f.ForeignName = InFile.ReadLine\r\n If \"End\" <> InFile.ReadLine Then\r\n Set f = Nothing\r\n Err.Raise 40000, \"VCS_ImportRelation\", \"Missing 'End' for a 'Begin' in \" & filePath\r\n End If\r\n rel.Fields.Append f\r\n End If\r\n Loop\r\n \r\n InFile.Close\r\n \r\n ' Skip if relationship already exists and make a note of it. It was embedded in the table schema.\r\n On Error GoTo ErrorHandler\r\n CurrentDb.Relations.Append rel\r\n \r\n Exit Sub\r\nErrorHandler:\r\n Select Case Err.Number\r\n Case 3012 ' Relationship already exists\r\n Debug.Print \"Skipped: \"\"\" & rel.Name & \"\"\" \";\r\n Resume Next ' Skip it and move on\r\n Case Else\r\n Resume Next ' Move on anyways\r\n End Select\r\nEnd Sub\r\n"
},
{
"path": "MSAccess-VCS/VCS_Report.bas",
"content": "Attribute VB_Name = \"VCS_Report\"\r\nOption Compare Database\r\n\r\nOption Private Module\r\nOption Explicit\r\n\r\n' --------------------------------\r\n' Structures\r\n' --------------------------------\r\n\r\nPrivate Type str_DEVMODE\r\n RGB As String * 94\r\nEnd Type\r\n\r\nPrivate Type type_DEVMODE\r\n strDeviceName(31) As Byte 'vba strings are encoded in unicode (16 bit) not ascii\r\n intSpecVersion As Integer\r\n intDriverVersion As Integer\r\n intSize As Integer\r\n intDriverExtra As Integer\r\n lngFields As Long\r\n intOrientation As Integer\r\n intPaperSize As Integer\r\n intPaperLength As Integer\r\n intPaperWidth As Integer\r\n intScale As Integer\r\n intCopies As Integer\r\n intDefaultSource As Integer\r\n intPrintQuality As Integer\r\n intColor As Integer\r\n intDuplex As Integer\r\n intResolution As Integer\r\n intTTOption As Integer\r\n intCollate As Integer\r\n strFormName(31) As Byte\r\n lngPad As Long\r\n lngBits As Long\r\n lngPW As Long\r\n lngPH As Long\r\n lngDFI As Long\r\n lngDFr As Long\r\nEnd Type\r\n\r\n\r\n'Exports print vars for reports\r\nPublic Sub VCS_ExportPrintVars(ByVal obj_name As String, ByVal filePath As String)\r\n DoEvents\r\n Dim FSO As Object\r\n Set FSO = CreateObject(\"Scripting.FileSystemObject\")\r\n \r\n Dim DevModeString As str_DEVMODE\r\n Dim DevModeExtra As String\r\n Dim DM As type_DEVMODE\r\n Dim rpt As Report\r\n \r\n 'report must be open to access Report object\r\n 'report must be opened in design view to save changes to the print vars\r\n DoCmd.OpenReport obj_name, acViewDesign\r\n Set rpt = Reports(obj_name)\r\n \r\n \r\n 'read print vars into struct\r\n If Not IsNull(rpt.PrtDevMode) Then\r\n DevModeExtra = rpt.PrtDevMode\r\n DevModeString.RGB = DevModeExtra\r\n LSet DM = DevModeString\r\n Else\r\n Set rpt = Nothing\r\n DoCmd.Close acReport, obj_name, acSaveNo\r\n Debug.Print \"Warning: PrtDevMode is null\"\r\n Exit Sub\r\n End If\r\n \r\n Dim OutFile As Object\r\n Set OutFile = FSO.CreateTextFile(filePath, overwrite:=True, Unicode:=False)\r\n \r\n 'print out print var values\r\n OutFile.WriteLine DM.intOrientation\r\n OutFile.WriteLine DM.intPaperSize\r\n OutFile.WriteLine DM.intPaperLength\r\n OutFile.WriteLine DM.intPaperWidth\r\n OutFile.WriteLine DM.intScale\r\n OutFile.Close\r\n \r\n Set rpt = Nothing\r\n \r\n DoCmd.Close acReport, obj_name, acSaveYes\r\nEnd Sub\r\n\r\nPublic Sub VCS_ImportPrintVars(ByVal obj_name As String, ByVal filePath As String)\r\n \r\n Dim FSO As Object\r\n Set FSO = CreateObject(\"Scripting.FileSystemObject\")\r\n \r\n Dim DevModeString As str_DEVMODE\r\n Dim DevModeExtra As String\r\n \r\n Dim DM As type_DEVMODE\r\n Dim rpt As Report\r\n 'report must be open to access Report object\r\n 'report must be opened in design view to save changes to the print vars\r\n \r\n DoCmd.OpenReport obj_name, acViewDesign\r\n \r\n Set rpt = Reports(obj_name)\r\n \r\n 'read print vars into struct\r\n If Not IsNull(rpt.PrtDevMode) Then\r\n DevModeExtra = rpt.PrtDevMode\r\n DevModeString.RGB = DevModeExtra\r\n LSet DM = DevModeString\r\n Else\r\n Set rpt = Nothing\r\n DoCmd.Close acReport, obj_name, acSaveNo\r\n Debug.Print \"Warning: PrtDevMode is null\"\r\n Exit Sub\r\n End If\r\n \r\n Dim InFile As Object\r\n Set InFile = FSO.OpenTextFile(filePath, iomode:=ForReading, create:=False, Format:=TristateFalse)\r\n \r\n 'print out print var values\r\n DM.intOrientation = InFile.ReadLine\r\n DM.intPaperSize = InFile.ReadLine\r\n DM.intPaperLength = InFile.ReadLine\r\n DM.intPaperWidth = InFile.ReadLine\r\n DM.intScale = InFile.ReadLine\r\n InFile.Close\r\n \r\n 'write print vars back into report\r\n LSet DevModeString = DM\r\n Mid(DevModeExtra, 1, 94) = DevModeString.RGB\r\n rpt.PrtDevMode = DevModeExtra\r\n \r\n Set rpt = Nothing\r\n \r\n DoCmd.Close acReport, obj_name, acSaveYes\r\nEnd Sub"
},
{
"path": "MSAccess-VCS/VCS_String.bas",
"content": "Attribute VB_Name = \"VCS_String\"\r\nOption Compare Database\r\n\r\nOption Private Module\r\nOption Explicit\r\n\r\n\r\n'--------------------\r\n' String Functions: String Builder,String Padding (right only), Substrings\r\n'--------------------\r\n\r\n' String builder: Init\r\nPublic Function VCS_Sb_Init() As String()\r\n Dim x(-1 To -1) As String\r\n VCS_Sb_Init = x\r\nEnd Function\r\n\r\n' String builder: Clear\r\nPublic Sub VCS_Sb_Clear(ByRef sb() As String)\r\n ReDim VCS_Sb_Init(-1 To -1)\r\nEnd Sub\r\n\r\n' String builder: Append\r\nPublic Sub VCS_Sb_Append(ByRef sb() As String, ByVal Value As String)\r\n If LBound(sb) = -1 Then\r\n ReDim sb(0 To 0)\r\n Else\r\n ReDim Preserve sb(0 To UBound(sb) + 1)\r\n End If\r\n sb(UBound(sb)) = Value\r\nEnd Sub\r\n\r\n' String builder: Get value\r\nPublic Function VCS_Sb_Get(ByRef sb() As String) As String\r\n VCS_Sb_Get = Join(sb, \"\")\r\nEnd Function\r\n\r\n\r\n' Pad a string on the right to make it `count` characters long.\r\nPublic Function VCS_PadRight(ByVal Value As String, ByVal Count As Integer) As String\r\n VCS_PadRight = Value\r\n If Len(Value) < Count Then\r\n VCS_PadRight = VCS_PadRight & Space$(Count - Len(Value))\r\n End If\r\nEnd Function\r\n\r\n' Remove escape characters\r\nPublic Function VCS_RmEsc(Value)\r\n Dim i As Integer\r\n Dim nextChar As String\r\n \r\n If VarType(Value) <> vbString Then\r\n VCS_RmEsc = Value\r\n Exit Function\r\n End If\r\n \r\n i = InStr(1, Value, \"\\\")\r\n Do Until i = 0\r\n nextChar = Mid(Value, i + 1, 1)\r\n Select Case nextChar\r\n Case \"\\\"\r\n Value = left(Value, i - 1) & \"\\\" & Mid(Value, i + 2)\r\n Case \"n\"\r\n Value = left(Value, i - 1) & vbCrLf & Mid(Value, i + 2)\r\n Case \"t\"\r\n Value = left(Value, i - 1) & vbTab & Mid(Value, i + 2)\r\n End Select\r\n i = InStr(i + 1, Value, \"\\\")\r\n Loop\r\n VCS_RmEsc = Value\r\nEnd Function\r\n"
},
{
"path": "MSAccess-VCS/VCS_Table.bas",
"content": "Attribute VB_Name = \"VCS_Table\"\r\nOption Compare Database\r\n\r\nOption Private Module\r\nOption Explicit\r\n\r\n\r\n\r\n\r\n\r\nPublic Sub VCS_ExportLinkedTable(ByVal tbl_name As String, ByVal obj_path As String)\r\n On Error GoTo Err_LinkedTable\r\n \r\n Dim tempFilePath As String\r\n \r\n tempFilePath = VCS_File.VCS_TempFile()\r\n \r\n Dim FSO As Object\r\n Dim OutFile As Object\r\n\r\n Set FSO = CreateObject(\"Scripting.FileSystemObject\")\r\n ' open file for writing with Create=True, Unicode=True (USC-2 Little Endian format)\r\n VCS_Dir.VCS_MkDirIfNotExist obj_path\r\n \r\n Set OutFile = FSO.CreateTextFile(tempFilePath, overwrite:=True, Unicode:=True)\r\n \r\n OutFile.Write CurrentDb.TableDefs(tbl_name).Name\r\n OutFile.Write vbCrLf\r\n \r\n If InStr(1, CurrentDb.TableDefs(tbl_name).connect, \"DATABASE=\" & CurrentProject.Path) Then\r\n 'change to relatave path\r\n Dim connect() As String\r\n connect = Split(CurrentDb.TableDefs(tbl_name).connect, CurrentProject.Path)\r\n OutFile.Write connect(0) & \".\" & connect(1)\r\n Else\r\n OutFile.Write CurrentDb.TableDefs(tbl_name).connect\r\n End If\r\n \r\n OutFile.Write vbCrLf\r\n OutFile.Write CurrentDb.TableDefs(tbl_name).SourceTableName\r\n OutFile.Write vbCrLf\r\n \r\n Dim Db As DAO.Database\r\n Set Db = CurrentDb\r\n Dim td As DAO.TableDef\r\n Set td = Db.TableDefs(tbl_name)\r\n Dim idx As DAO.Index\r\n \r\n For Each idx In td.Indexes\r\n If idx.Primary Then\r\n OutFile.Write Right$(idx.Fields, Len(idx.Fields) - 1)\r\n OutFile.Write vbCrLf\r\n End If\r\n\r\n Next\r\n \r\nErr_LinkedTable_Fin:\r\n On Error Resume Next\r\n OutFile.Close\r\n 'save files as .odbc\r\n VCS_File.VCS_ConvertUcs2Utf8 tempFilePath, obj_path & tbl_name & \".LNKD\"\r\n \r\n Exit Sub\r\n \r\nErr_LinkedTable:\r\n OutFile.Close\r\n MsgBox Err.Description, vbCritical, \"ERROR: EXPORT LINKED TABLE\"\r\n Resume Err_LinkedTable_Fin\r\nEnd Sub\r\n\r\n' Save a Table Definition as SQL statement\r\nPublic Sub VCS_ExportTableDef(ByVal TableName As String, ByVal directory As String)\r\n Dim fileName As String\r\n fileName = directory & TableName & \".xml\"\r\n \r\n Application.ExportXML _\r\n ObjectType:=acExportTable, _\r\n DataSource:=TableName, _\r\n SchemaTarget:=fileName\r\n \r\n 'exort Data Macros\r\n VCS_DataMacro.VCS_ExportDataMacros TableName, directory\r\nEnd Sub\r\n\r\n\r\n' Determine if a table or exists.\r\n' based on sample code of support.microsoftcom\r\n' ARGUMENTS:\r\n' TName: The name of a table or query.\r\n'\r\n' RETURNS: True (it exists) or False (it does not exist).\r\nPrivate Function TableExists(ByVal TName As String) As Boolean\r\n Dim Db As DAO.Database\r\n Dim Found As Boolean\r\n Dim Test As String\r\n \r\n Const NAME_NOT_IN_COLLECTION As Integer = 3265\r\n \r\n ' Assume the table or query does not exist.\r\n Found = False\r\n Set Db = CurrentDb()\r\n \r\n ' Trap for any errors.\r\n On Error Resume Next\r\n \r\n ' See if the name is in the Tables collection.\r\n Test = Db.TableDefs(TName).Name\r\n If Err.Number <> NAME_NOT_IN_COLLECTION Then Found = True\r\n \r\n ' Reset the error variable.\r\n Err = 0\r\n \r\n TableExists = Found\r\nEnd Function\r\n\r\n' Build SQL to export `tbl_name` sorted by each field from first to last\r\nPrivate Function TableExportSql(ByVal tbl_name As String) As String\r\n Dim rs As Object ' DAO.Recordset\r\n Dim fieldObj As Object ' DAO.Field\r\n Dim sb() As String, Count As Integer\r\n\r\n Set rs = CurrentDb.OpenRecordset(tbl_name)\r\n \r\n sb = VCS_String.VCS_Sb_Init()\r\n VCS_String.VCS_Sb_Append sb, \"SELECT \"\r\n \r\n Count = 0\r\n For Each fieldObj In rs.Fields\r\n If Count > 0 Then VCS_String.VCS_Sb_Append sb, \", \"\r\n VCS_String.VCS_Sb_Append sb, \"[\" & fieldObj.Name & \"]\"\r\n Count = Count + 1\r\n Next\r\n \r\n VCS_String.VCS_Sb_Append sb, \" FROM [\" & tbl_name & \"] ORDER BY \"\r\n \r\n Count = 0\r\n For Each fieldObj In rs.Fields\r\n DoEvents\r\n If Count > 0 Then VCS_String.VCS_Sb_Append sb, \", \"\r\n VCS_String.VCS_Sb_Append sb, \"[\" & fieldObj.Name & \"]\"\r\n Count = Count + 1\r\n Next\r\n\r\n TableExportSql = VCS_String.VCS_Sb_Get(sb)\r\nEnd Function\r\n\r\n' Export the lookup table `tblName` to `source\\tables`.\r\nPublic Sub VCS_ExportTableData(ByVal tbl_name As String, ByVal obj_path As String)\r\n Dim FSO As Object\r\n Dim OutFile As Object\r\n Dim rs As DAO.Recordset ' DAO.Recordset\r\n Dim fieldObj As Object ' DAO.Field\r\n Dim c As Long, Value As Variant\r\n \r\n ' Checks first\r\n If Not TableExists(tbl_name) Then\r\n Debug.Print \"Error: Table \" & tbl_name & \" missing\"\r\n Exit Sub\r\n End If\r\n \r\n Set rs = CurrentDb.OpenRecordset(TableExportSql(tbl_name))\r\n If rs.RecordCount = 0 Then\r\n 'why is this an error? Debug.Print \"Error: Table \" & tbl_name & \" empty\"\r\n rs.Close\r\n Exit Sub\r\n End If\r\n\r\n Set FSO = CreateObject(\"Scripting.FileSystemObject\")\r\n ' open file for writing with Create=True, Unicode=True (USC-2 Little Endian format)\r\n VCS_Dir.VCS_MkDirIfNotExist obj_path\r\n Dim tempFileName As String\r\n tempFileName = VCS_File.VCS_TempFile()\r\n\r\n Set OutFile = FSO.CreateTextFile(tempFileName, overwrite:=True, Unicode:=True)\r\n\r\n c = 0\r\n For Each fieldObj In rs.Fields\r\n If c <> 0 Then OutFile.Write vbTab\r\n c = c + 1\r\n OutFile.Write fieldObj.Name\r\n Next\r\n OutFile.Write vbCrLf\r\n\r\n rs.MoveFirst\r\n Do Until rs.EOF\r\n c = 0\r\n For Each fieldObj In rs.Fields\r\n DoEvents\r\n If c <> 0 Then OutFile.Write vbTab\r\n c = c + 1\r\n Value = rs(fieldObj.Name)\r\n If IsNull(Value) Then\r\n Value = vbNullString\r\n ElseIf VarType(Value) = vbBoolean Then\r\n Value = CInt(Value)\r\n Else\r\n Value = Replace(Value, \"\\\", \"\\\\\")\r\n Value = Replace(Value, vbCrLf, \"\\n\")\r\n Value = Replace(Value, vbCr, \"\\n\")\r\n Value = Replace(Value, vbLf, \"\\n\")\r\n Value = Replace(Value, vbTab, \"\\t\")\r\n End If\r\n OutFile.Write Value\r\n Next\r\n OutFile.Write vbCrLf\r\n rs.MoveNext\r\n Loop\r\n rs.Close\r\n OutFile.Close\r\n\r\n VCS_File.VCS_ConvertUcs2Utf8 tempFileName, obj_path & tbl_name & \".txt\"\r\n FSO.DeleteFile tempFileName\r\nEnd Sub\r\n\r\nPublic Sub VCS_ImportLinkedTable(ByVal tblName As String, ByRef obj_path As String)\r\n Dim Db As DAO.Database\r\n Dim FSO As Object\r\n Dim InFile As Object\r\n \r\n Set Db = CurrentDb\r\n Set FSO = CreateObject(\"Scripting.FileSystemObject\")\r\n \r\n Dim tempFilePath As String\r\n tempFilePath = VCS_File.VCS_TempFile()\r\n \r\n VCS_ConvertUtf8Ucs2 obj_path & tblName & \".LNKD\", tempFilePath\r\n ' open file for reading with Create=False, Unicode=True (USC-2 Little Endian format)\r\n Set InFile = FSO.OpenTextFile(tempFilePath, iomode:=ForReading, create:=False, Format:=TristateTrue)\r\n \r\n On Error GoTo err_notable:\r\n DoCmd.DeleteObject acTable, tblName\r\n \r\n GoTo err_notable_fin\r\n \r\nerr_notable:\r\n Err.Clear\r\n Resume err_notable_fin\r\n \r\nerr_notable_fin:\r\n On Error GoTo Err_CreateLinkedTable:\r\n \r\n Dim td As DAO.TableDef\r\n Set td = Db.CreateTableDef(InFile.ReadLine())\r\n \r\n Dim connect As String\r\n connect = InFile.ReadLine()\r\n If InStr(1, connect, \"DATABASE=.\\\") Then 'replace relative path with literal path\r\n connect = Replace(connect, \"DATABASE=.\\\", \"DATABASE=\" & CurrentProject.Path & \"\\\")\r\n End If\r\n td.Attributes = dbAttachSavePWD\r\n td.connect = connect\r\n \r\n td.SourceTableName = InFile.ReadLine()\r\n Db.TableDefs.Append td\r\n \r\n GoTo Err_CreateLinkedTable_Fin\r\n \r\nErr_CreateLinkedTable:\r\n MsgBox Err.Description, vbCritical, \"ERROR: IMPORT LINKED TABLE\"\r\n Resume Err_CreateLinkedTable_Fin\r\n \r\nErr_CreateLinkedTable_Fin:\r\n 'this will throw errors if a primary key already exists or the table is linked to an access database table\r\n 'will also error out if no pk is present\r\n On Error GoTo Err_LinkPK_Fin:\r\n \r\n Dim Fields As String\r\n Fields = InFile.ReadLine()\r\n Dim Field As Variant\r\n Dim sql As String\r\n sql = \"CREATE INDEX __uniqueindex ON \" & td.Name & \" (\"\r\n \r\n For Each Field In Split(Fields, \";+\")\r\n sql = sql & \"[\" & Field & \"]\" & \",\"\r\n Next\r\n 'remove extraneous comma\r\n sql = Left$(sql, Len(sql) - 1)\r\n \r\n sql = sql & \") WITH PRIMARY\"\r\n CurrentDb.Execute sql\r\n \r\nErr_LinkPK_Fin:\r\n On Error Resume Next\r\n InFile.Close\r\n \r\nEnd Sub\r\n\r\n' Import Table Definition\r\nPublic Sub VCS_ImportTableDef(ByVal tblName As String, ByVal directory As String)\r\n Dim filePath As String\r\n \r\n filePath = directory & tblName & \".xml\"\r\n Application.ImportXML DataSource:=filePath, ImportOptions:=acStructureOnly\r\n\r\nEnd Sub\r\n\r\n' Import the lookup table `tblName` from `source\\tables`.\r\nPublic Sub VCS_ImportTableData(ByVal tblName As String, ByVal obj_path As String)\r\n Dim Db As Object ' DAO.Database\r\n Dim rs As Object ' DAO.Recordset\r\n Dim fieldObj As Object ' DAO.Field\r\n Dim FSO As Object\r\n Dim InFile As Object\r\n Dim c As Long, buf As String, Values() As String, Value As Variant\r\n\r\n Set FSO = CreateObject(\"Scripting.FileSystemObject\")\r\n \r\n Dim tempFileName As String\r\n tempFileName = VCS_File.VCS_TempFile()\r\n VCS_File.VCS_ConvertUtf8Ucs2 obj_path & tblName & \".txt\", tempFileName\r\n ' open file for reading with Create=False, Unicode=True (USC-2 Little Endian format)\r\n Set InFile = FSO.OpenTextFile(tempFileName, iomode:=ForReading, create:=False, Format:=TristateTrue)\r\n Set Db = CurrentDb\r\n\r\n Db.Execute \"DELETE FROM [\" & tblName & \"]\"\r\n Set rs = Db.OpenRecordset(tblName)\r\n buf = InFile.ReadLine()\r\n Do Until InFile.AtEndOfStream\r\n buf = InFile.ReadLine()\r\n If Len(Trim$(buf)) > 0 Then\r\n Values = Split(buf, vbTab)\r\n c = 0\r\n rs.AddNew\r\n For Each fieldObj In rs.Fields\r\n DoEvents\r\n Value = Values(c)\r\n If Len(Value) = 0 Then\r\n Value = Null\r\n Else\r\n Value = VCS_String.VCS_RmEsc(Value)\r\n End If\r\n rs(fieldObj.Name) = Value\r\n c = c + 1\r\n Next\r\n rs.Update\r\n End If\r\n Loop\r\n\r\n rs.Close\r\n InFile.Close\r\n FSO.DeleteFile tempFileName\r\nEnd Sub\r\n"
},
{
"path": "README.md",
"content": "msaccess-vcs-integration\n========================\n\n[](https://gitter.im/timabell/msaccess-vcs-integration?utm_source=badge&utm_medium=badge&utm_campaign=pr-badge&utm_content=badge)\n\n# Warning\n\nThis tool can delete / break things, **take a backup before getting started**.\n\n# Alternatives\n\nThis project was forked and comprehensively re-written into an add-in for access. Considerably more work has been done on that version so I strongly suggest checking out [joyfullservice/msaccess-vcs-addin](https://github.com/joyfullservice/msaccess-vcs-addin) before choosing which tool to use.\n\n# About\n\nSynchronize your Microsoft Access Database definition with a version control system.\n\nIncluded in the export/import:\n\n* Queries\n* Forms\n* Reports\n* Macros\n* Modules\n* Table Data\n* Table Definitions\n* Table Data Macros\n\nNot included in the export/import:\n\n* Customized toolbars, toolbar items, and menu items\n* Any external files\n* Pretty much anything that is not accessible by browsing the design, properties, and code of a Query, Form, Report, Macro, or Module object.\n\n*This code is built and tested on Microsoft Access 2010/2013. It will probably work in earlier/later versions, but YMMV.*\n\nThis 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.)\n\n# Encoding\n\nFor 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](https://www.mercurial-scm.org/wiki/BinaryFiles).\n\n# Output\n\nThe 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.\n\n\n# Installing the Integration Scripts\n\nFor the purposes of these instructions, assume your database is called `Application.accdb`.\n\n1. Load `VCS_Loader.bas` into a new module in your database with that exact name.\n 1. Go to the VBA editor (CTRL-G) and select \"File\" > \"Import File...\"\n (or you can just drag and drop the file from windows explorer into the vba editor module list).\n 2. Select the `VCS_Loader.bas` file.\n 3. Save the file (CTRL-S).\n2. 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;\ne.g. `loadVCS \"C:\\Users\\MyUserAccount\\Documents\\Access-Proj\\MSAccess-VCS\\\"` - the trailing slash is required\nor `loadVCS` will not import the new modules.\n3. 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.)\n\n# Updating UIRibbon\n\n1. Right click anywhere on the ribbon, click `customize ribbon`.\n \n2. Then click on `Import/Export` then click `import customization file` and open `./UIRibbon/FORM UPDATES.exportedUI`.\n \n\n# Configuring export\n\nBy 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.\n\nAdditionally, if a type of data should not be exported, change the \"Export_\" constants to `False` in `VCS_ImportExport.bas`. Report, Query, Form, Macro, Module, and Table exports can be disabled individually.\n\n# Supplied databases\n\nIn 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.\n\n# First Commit to Your Source Control System\n\n1. Create a repository in the folder containing your database.\n2. Compact and Repair `Application.accdb` and zip it to `Application.zip` using the Send to Compressed Folder command in Windows Explorer.\n3. 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].\"\n4. 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.\"\n5. 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]\".\n6. Publish your repository to your preferred central sharing location.\n\n# Committing New Progress and Pulling Changes from Other Developers\n\n1. 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.\"\n2. 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.\n3. 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.\n4. Push all local and merged changes back to the central sharing location.\n5. 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.\"\n\n# Committing a New \"Release\" of Your Project\n\n1. 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]\".\n2. Follow the usual steps in the previous section \"Committing New Progress\".\n3. Use your repository's \"tag\" function to tag your last commit with the release number/name.\n\n# Loading/updating a database from the exported files\n\n1. Create a new Access database (or use the supplied `demo\\blank.accdb`).\n2. Follow the instructions for installing the scripts.\n3. 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.\n4. Wait until the code finishes executing, Compact and Repair the database.\n\n# Caveats\n\n* 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.\n* 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.\n\n# Contributing\n\nPull requests, issue reports etc welcomed.\n\nhttps://github.com/msaccess-vcs-integration/msaccess-vcs-integration is 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! \n\nSeveral other people have been made collaborators to help keep the repo alive. Better ideas for running this project would be welcome, please discuss in [the related issue](https://github.com/timabell/msaccess-vcs-integration/issues/32).\n\n# Related tools\n\n* Add-in version of this: https://github.com/joyfullservice/msaccess-vcs-integration\n"
},
{
"path": "UIRibbon/FORM UPDATES.exportedUI",
"content": "\n\n \n \n \n \n \n \n \n \n \n \n \n \n \n\n"
},
{
"path": "VCS_Loader.bas",
"content": "Attribute VB_Name = \"VCS_Loader\"\r\nOption Compare Database\r\n\r\nOption Explicit\r\n\r\nPublic Sub loadVCS(Optional ByVal SourceDirectory As String)\r\n If SourceDirectory = vbNullString Then\r\n SourceDirectory = CurrentProject.Path & \"\\MSAccess-VCS\\\"\r\n End If\r\n\r\n'check if directory exists! - SourceDirectory could be a file or not exist\r\nOn Error GoTo Err_DirCheck\r\n If ((GetAttr(SourceDirectory) And vbDirectory) = vbDirectory) Then\r\n GoTo Fin_DirCheck\r\n Else\r\n 'SourceDirectory is not a directory\r\n Err.Raise 60000, \"loadVCS\", \"Source Directory specified is not a directory\"\r\n End If\r\n\r\nErr_DirCheck:\r\n \r\n If Err.Number = 53 Then 'SourceDirectory does not exist\r\n Debug.Print \"Error: \" & Err.Number & \" | \" & \"File/Directory not found\"\r\n Else\r\n Debug.Print \"Error: \" & Err.Number & \" | \" & Err.Description\r\n End If\r\n Exit Sub\r\nFin_DirCheck:\r\n\r\n 'delete if modules already exist + provide warning of deletion?\r\n\r\n On Error GoTo Err_DelHandler\r\n\r\n Dim fileName As String\r\n 'Use the list of files to import as the list to delete\r\n fileName = Dir$(SourceDirectory & \"*.bas\")\r\n Do Until Len(fileName) = 0\r\n 'strip file type from file name\r\n fileName = Left$(fileName, InStrRev(fileName, \".bas\") - 1)\r\n DoCmd.DeleteObject acModule, fileName\r\n fileName = Dir$()\r\n Loop\r\n\r\n GoTo Fin_DelHandler\r\n \r\nErr_DelHandler:\r\n If Err.Number <> 7874 Then 'is not - can't find object\r\n Debug.Print \"WARNING (\" & Err.Number & \") | \" & Err.Description\r\n End If\r\n Resume Next\r\n \r\nFin_DelHandler:\r\n fileName = vbNullString\r\n\r\n'import files from specific dir? or allow user to input their own dir?\r\nOn Error GoTo Err_LoadHandler\r\n\r\n fileName = Dir$(SourceDirectory & \"*.bas\")\r\n Do Until Len(fileName) = 0\r\n 'strip file type from file name\r\n fileName = Left$(fileName, InStrRev(fileName, \".bas\") - 1)\r\n Application.LoadFromText acModule, fileName, SourceDirectory & fileName & \".bas\"\r\n fileName = Dir$()\r\n Loop\r\n\r\n GoTo Fin_LoadHandler\r\n \r\nErr_LoadHandler:\r\n Debug.Print \"Error: \" & Err.Number & \" | \" & Err.Description\r\n Resume Next\r\n\r\nFin_LoadHandler:\r\n displayFormVersion SourceDirectory\r\n\r\nEnd Sub\r\n\r\nPublic Sub displayFormVersion(ByVal SourceDirectory As String)\r\nOn Error GoTo Err_FormVersion\r\n Dim versionPath As String, FormsVersion As String, textline As String, posLat As Integer, posLong As Integer\r\n versionPath = SourceDirectory & \"..\\VERSION.txt\"\r\n Open versionPath For Input As #1\r\n\r\n Do Until EOF(1)\r\n Line Input #1, textline\r\n FormsVersion = FormsVersion & textline\r\n \r\n Loop\r\n Close #1\r\n\r\n MsgBox \"Form Version: \" & FormsVersion & \" loaded\"\r\n\r\n GoTo Fin_FormVersion\r\n \r\nErr_FormVersion:\r\n\r\n If Err.Number = 53 Then 'VERSION.txt does not exist\r\n Debug.Print \"Error: \" & Err.Number & \" | \" & \"Path to VERSION.txt not found\"\r\n Else\r\n Debug.Print \"Error: \" & Err.Number & \" | \" & Err.Description\r\n End If\r\n Exit Sub\r\n\r\nFin_FormVersion:\r\n Debug.Print \"Done\"\r\n\r\nEnd Sub\r\n"
},
{
"path": "VERSION.txt",
"content": "1.0.1_beta\n"
},
{
"path": "demo/README.md",
"content": "demo\\\n=====\n\nDatabases supplied for convenience\n\n`demo.accdb`\n\nUse this for:\n\n* trying out this project\n* for testing updates to this project\n\n`blank.accdb`\n\nUse this for:\n\n* testing importing\n* a base for your own projects, to supply with source controlled files to other people\n"
},
{
"path": "demo/source/forms/people.bas",
"content": "Version =20\r\nVersionRequired =20\r\nBegin Form\r\n AutoCenter = NotDefault\r\n DividingLines = NotDefault\r\n AllowDesignChanges = NotDefault\r\n ViewsAllowed =1\r\n PictureAlignment =2\r\n DatasheetGridlinesBehavior =3\r\n GridX =24\r\n GridY =24\r\n Width =11400\r\n DatasheetFontHeight =11\r\n ItemSuffix =5\r\n Right =15735\r\n Bottom =10215\r\n DatasheetGridlinesColor =14806254\r\n RecSrcDt = Begin\r\n 0x69f339541c33e440\r\n End\r\n RecordSource =\"people\"\r\n Caption =\"people\"\r\n DatasheetFontName =\"Calibri\"\r\n PrtMip = Begin\r\n 0x6801000068010000680100006801000000000000201c0000e010000001000000 ,\r\n 0x010000006801000000000000a10700000100000001000000\r\n End\r\n AllowDatasheetView =0\r\n AllowPivotTableView =0\r\n AllowPivotChartView =0\r\n AllowPivotChartView =0\r\n FilterOnLoad =0\r\n ShowPageMargins =0\r\n DisplayOnSharePointSite =1\r\n DatasheetAlternateBackColor =15921906\r\n DatasheetGridlinesColor12 =0\r\n FitToScreen =1\r\n DatasheetBackThemeColorIndex =1\r\n BorderThemeColorIndex =3\r\n ThemeFontIndex =1\r\n ForeThemeColorIndex =0\r\n AlternateBackThemeColorIndex =1\r\n AlternateBackShade =95.0\r\n Begin\r\n Begin Label\r\n BackStyle =0\r\n FontSize =11\r\n FontName =\"Calibri\"\r\n ThemeFontIndex =1\r\n BackThemeColorIndex =1\r\n BorderThemeColorIndex =0\r\n BorderTint =50.0\r\n ForeThemeColorIndex =0\r\n ForeTint =50.0\r\n GridlineThemeColorIndex =1\r\n GridlineShade =65.0\r\n End\r\n Begin TextBox\r\n AddColon = NotDefault\r\n FELineBreak = NotDefault\r\n BorderLineStyle =0\r\n LabelX =-1800\r\n FontSize =11\r\n FontName =\"Calibri\"\r\n AsianLineBreak =1\r\n BackThemeColorIndex =1\r\n BorderThemeColorIndex =1\r\n BorderShade =65.0\r\n ThemeFontIndex =1\r\n ForeThemeColorIndex =0\r\n ForeTint =75.0\r\n GridlineThemeColorIndex =1\r\n GridlineShade =65.0\r\n End\r\n Begin ComboBox\r\n AddColon = NotDefault\r\n BorderLineStyle =0\r\n LabelX =-1800\r\n FontSize =11\r\n FontName =\"Calibri\"\r\n AllowValueListEdits =1\r\n InheritValueList =1\r\n ThemeFontIndex =1\r\n BackThemeColorIndex =1\r\n BorderThemeColorIndex =1\r\n BorderShade =65.0\r\n ForeThemeColorIndex =2\r\n ForeShade =50.0\r\n GridlineThemeColorIndex =1\r\n GridlineShade =65.0\r\n End\r\n Begin FormHeader\r\n Height =1080\r\n BackColor =15849926\r\n Name =\"FormHeader\"\r\n AutoHeight =1\r\n AlternateBackThemeColorIndex =1\r\n AlternateBackShade =95.0\r\n BackThemeColorIndex =2\r\n BackTint =20.0\r\n Begin\r\n Begin Label\r\n OverlapFlags =85\r\n TextAlign =1\r\n Left =360\r\n Top =720\r\n Width =7260\r\n Height =315\r\n BorderColor =8355711\r\n ForeColor =8355711\r\n Name =\"full_name_Label\"\r\n Caption =\"full_name\"\r\n Tag =\"DetachedLabel\"\r\n GridlineStyleBottom =1\r\n GridlineColor =10921638\r\n LayoutCachedLeft =360\r\n LayoutCachedTop =720\r\n LayoutCachedWidth =7620\r\n LayoutCachedHeight =1035\r\n End\r\n Begin Label\r\n OverlapFlags =85\r\n TextAlign =1\r\n Left =7680\r\n Top =720\r\n Width =3660\r\n Height =315\r\n BorderColor =8355711\r\n ForeColor =8355711\r\n Name =\"favorite_color_Label\"\r\n Caption =\"favorite_color\"\r\n Tag =\"DetachedLabel\"\r\n GridlineStyleBottom =1\r\n GridlineColor =10921638\r\n LayoutCachedLeft =7680\r\n LayoutCachedTop =720\r\n LayoutCachedWidth =11340\r\n LayoutCachedHeight =1035\r\n End\r\n Begin Label\r\n OverlapFlags =215\r\n Left =60\r\n Top =60\r\n Width =1440\r\n Height =1020\r\n FontSize =20\r\n BorderColor =8355711\r\n ForeColor =8355711\r\n Name =\"Label4\"\r\n Caption =\"people\"\r\n GridlineColor =10921638\r\n LayoutCachedLeft =60\r\n LayoutCachedTop =60\r\n LayoutCachedWidth =1500\r\n LayoutCachedHeight =1080\r\n End\r\n End\r\n End\r\n Begin Section\r\n Height =720\r\n Name =\"Detail\"\r\n AutoHeight =1\r\n AlternateBackColor =15921906\r\n AlternateBackThemeColorIndex =1\r\n AlternateBackShade =95.0\r\n BackThemeColorIndex =1\r\n Begin\r\n Begin TextBox\r\n EnterKeyBehavior = NotDefault\r\n ScrollBars =2\r\n OverlapFlags =85\r\n IMESentenceMode =3\r\n Left =360\r\n Top =60\r\n Width =7260\r\n Height =600\r\n ColumnWidth =3000\r\n BorderColor =10921638\r\n ForeColor =4210752\r\n Name =\"full_name\"\r\n ControlSource =\"full_name\"\r\n GridlineColor =10921638\r\n\r\n LayoutCachedLeft =360\r\n LayoutCachedTop =60\r\n LayoutCachedWidth =7620\r\n LayoutCachedHeight =660\r\n End\r\n Begin ComboBox\r\n LimitToList = NotDefault\r\n OverlapFlags =85\r\n IMESentenceMode =3\r\n ColumnCount =2\r\n ListWidth =1440\r\n Left =7680\r\n Top =60\r\n Width =3660\r\n Height =330\r\n ColumnWidth =3000\r\n TabIndex =1\r\n BorderColor =10921638\r\n ForeColor =4138256\r\n ColumnInfo =\"\\\"\\\";\\\"\\\";\\\"\\\";\\\"\\\";\\\"10\\\";\\\"30\\\"\"\r\n Name =\"favorite_color\"\r\n ControlSource =\"favorite_color\"\r\n RowSourceType =\"Table/Query\"\r\n RowSource =\"SELECT [color_lookup].[id], [color_lookup].[color] FROM color_lookup ORDER BY [i\"\r\n \"d]; \"\r\n ColumnWidths =\"0;1440\"\r\n GridlineColor =10921638\r\n\r\n LayoutCachedLeft =7680\r\n LayoutCachedTop =60\r\n LayoutCachedWidth =11340\r\n LayoutCachedHeight =390\r\n End\r\n End\r\n End\r\n Begin FormFooter\r\n Height =0\r\n Name =\"FormFooter\"\r\n AutoHeight =1\r\n AlternateBackThemeColorIndex =1\r\n AlternateBackShade =95.0\r\n BackThemeColorIndex =1\r\n End\r\n End\r\nEnd\r\n"
},
{
"path": "demo/source/macros/demo_macro.bas",
"content": "Version =196611\r\nColumnsShown =0\r\nBegin\r\n Action =\"MsgBox\"\r\n Argument =\"Hello world.\"\r\n Argument =\"-1\"\r\n Argument =\"0\"\r\nEnd\r\nBegin\r\n Comment =\"_AXL:\\015\\012Hello world.\"\r\nEnd\r\n"
},
{
"path": "demo/source/modules/DemoModule.bas",
"content": "Option Compare Database\r\nOption Explicit\r\n\r\nPublic Function DemoHello()\r\nDebug.Print \"Hello world.\"\r\nEnd Function"
},
{
"path": "demo/source/queries/demo_query.bas",
"content": "Operation =1\r\nOption =0\r\nWhere =\"(((color_lookup.color)=\\\"red\\\"))\"\r\nBegin InputTables\r\n Name =\"people\"\r\n Name =\"color_lookup\"\r\nEnd\r\nBegin OutputColumns\r\n Expression =\"people.full_name\"\r\n Expression =\"color_lookup.color\"\r\nEnd\r\nBegin Joins\r\n LeftTable =\"color_lookup\"\r\n RightTable =\"people\"\r\n Expression =\"color_lookup.id = people.favorite_color\"\r\n Flag =1\r\nEnd\r\ndbBoolean \"ReturnsRecords\" =\"-1\"\r\ndbInteger \"ODBCTimeout\" =\"60\"\r\ndbByte \"RecordsetType\" =\"0\"\r\ndbBoolean \"OrderByOn\" =\"0\"\r\ndbByte \"Orientation\" =\"0\"\r\ndbByte \"DefaultView\" =\"2\"\r\ndbBinary \"GUID\" = Begin\r\n 0x1d10bf75134eea4f83fa92cbf2ec3020\r\nEnd\r\ndbBoolean \"FilterOnLoad\" =\"0\"\r\ndbBoolean \"OrderByOnLoad\" =\"-1\"\r\ndbBoolean \"TotalsRow\" =\"0\"\r\nBegin\r\n Begin\r\n dbText \"Name\" =\"people.full_name\"\r\n dbLong \"AggregateType\" =\"-1\"\r\n End\r\n Begin\r\n dbText \"Name\" =\"color_lookup.color\"\r\n dbLong \"AggregateType\" =\"-1\"\r\n End\r\nEnd\r\nBegin\r\n State =0\r\n Left =0\r\n Top =0\r\n Right =1705\r\n Bottom =927\r\n Left =-1\r\n Top =-1\r\n Right =1685\r\n Bottom =433\r\n Left =0\r\n Top =0\r\n ColumnsShown =539\r\n Begin\r\n Left =48\r\n Top =12\r\n Right =192\r\n Bottom =156\r\n Top =0\r\n Name =\"people\"\r\n Name =\"\"\r\n End\r\n Begin\r\n Left =240\r\n Top =12\r\n Right =384\r\n Bottom =156\r\n Top =0\r\n Name =\"color_lookup\"\r\n Name =\"\"\r\n End\r\nEnd\r\n"
},
{
"path": "demo/source/references.csv",
"content": "{000204EF-0000-0000-C000-000000000046},4,1\r\n{4AFFC9A0-5F99-101B-AF4E-00AA003F0F07},9,0\r\n{00020430-0000-0000-C000-000000000046},2,0\r\n{4AC9E1DA-5BAD-4AC7-86E3-24F4CDCECA28},12,0\r\n"
},
{
"path": "demo/source/relations/RelationTbl1RelationTbl2.txt",
"content": "4352\r\nRelationTbl1RelationTbl2\r\nRelationTbl1\r\nRelationTbl2\r\nField = Begin\r\nPK\r\nF1\r\nEnd\r\n"
},
{
"path": "demo/source/reports/people.bas",
"content": "Version =20\r\nVersionRequired =20\r\nBegin Report\r\n LayoutForPrint = NotDefault\r\n DividingLines = NotDefault\r\n AllowDesignChanges = NotDefault\r\n DateGrouping =1\r\n GrpKeepTogether =1\r\n PictureAlignment =2\r\n DatasheetGridlinesBehavior =3\r\n GridX =24\r\n GridY =24\r\n Width =11400\r\n DatasheetFontHeight =11\r\n ItemSuffix =7\r\n DatasheetGridlinesColor =14806254\r\n RecSrcDt = Begin\r\n 0x83de6a571c33e440\r\n End\r\n RecordSource =\"people\"\r\n Caption =\"people\"\r\n DatasheetFontName =\"Calibri\"\r\n PrtMip = Begin\r\n 0xe0010000e0010000680100006801000000000000201c0000e010000001000000 ,\r\n 0x010000006801000000000000a10700000100000001000000\r\n End\r\n FilterOnLoad =0\r\n FitToPage =1\r\n DisplayOnSharePointSite =1\r\n DatasheetAlternateBackColor =15921906\r\n DatasheetGridlinesColor12 =0\r\n FitToScreen =1\r\n DatasheetBackThemeColorIndex =1\r\n BorderThemeColorIndex =3\r\n ThemeFontIndex =1\r\n ForeThemeColorIndex =0\r\n AlternateBackThemeColorIndex =1\r\n AlternateBackShade =95.0\r\n Begin\r\n Begin Label\r\n BackStyle =0\r\n FontSize =11\r\n FontName =\"Calibri\"\r\n ThemeFontIndex =1\r\n BackThemeColorIndex =1\r\n BorderThemeColorIndex =0\r\n BorderTint =50.0\r\n ForeThemeColorIndex =0\r\n ForeTint =50.0\r\n GridlineThemeColorIndex =1\r\n GridlineShade =65.0\r\n End\r\n Begin TextBox\r\n AddColon = NotDefault\r\n FELineBreak = NotDefault\r\n BorderLineStyle =0\r\n LabelX =-1800\r\n FontSize =11\r\n FontName =\"Calibri\"\r\n AsianLineBreak =1\r\n ShowDatePicker =0\r\n BackThemeColorIndex =1\r\n BorderThemeColorIndex =1\r\n BorderShade =65.0\r\n ThemeFontIndex =1\r\n ForeThemeColorIndex =0\r\n ForeTint =75.0\r\n GridlineThemeColorIndex =1\r\n GridlineShade =65.0\r\n End\r\n Begin ComboBox\r\n AddColon = NotDefault\r\n BorderLineStyle =0\r\n LabelX =-1800\r\n FontSize =11\r\n FontName =\"Calibri\"\r\n AllowValueListEdits =1\r\n InheritValueList =1\r\n ThemeFontIndex =1\r\n BackThemeColorIndex =1\r\n BorderThemeColorIndex =1\r\n BorderShade =65.0\r\n ForeThemeColorIndex =2\r\n ForeShade =50.0\r\n GridlineThemeColorIndex =1\r\n GridlineShade =65.0\r\n End\r\n Begin BreakLevel\r\n ControlSource =\"full_name\"\r\n End\r\n Begin FormHeader\r\n KeepTogether = NotDefault\r\n Height =960\r\n BackColor =15849926\r\n Name =\"ReportHeader\"\r\n AutoHeight =1\r\n AlternateBackThemeColorIndex =1\r\n AlternateBackShade =95.0\r\n BackThemeColorIndex =2\r\n BackTint =20.0\r\n Begin\r\n Begin Label\r\n Left =60\r\n Top =60\r\n Width =1200\r\n Height =540\r\n FontSize =20\r\n BorderColor =8355711\r\n ForeColor =8355711\r\n Name =\"Label4\"\r\n Caption =\"people\"\r\n GridlineColor =10921638\r\n LayoutCachedLeft =60\r\n LayoutCachedTop =60\r\n LayoutCachedWidth =1260\r\n LayoutCachedHeight =600\r\n End\r\n End\r\n End\r\n Begin PageHeader\r\n Height =435\r\n Name =\"PageHeaderSection\"\r\n AutoHeight =1\r\n AlternateBackThemeColorIndex =1\r\n AlternateBackShade =95.0\r\n BackThemeColorIndex =1\r\n Begin\r\n Begin Label\r\n OverlapFlags =4\r\n TextAlign =1\r\n Left =360\r\n Top =60\r\n Width =7260\r\n Height =315\r\n BorderColor =8355711\r\n ForeColor =8355711\r\n Name =\"full_name_Label\"\r\n Caption =\"full_name\"\r\n Tag =\"DetachedLabel\"\r\n GridlineStyleBottom =1\r\n GridlineColor =10921638\r\n LayoutCachedLeft =360\r\n LayoutCachedTop =60\r\n LayoutCachedWidth =7620\r\n LayoutCachedHeight =375\r\n End\r\n Begin Label\r\n OverlapFlags =4\r\n TextAlign =1\r\n Left =7680\r\n Top =60\r\n Width =3660\r\n Height =315\r\n BorderColor =8355711\r\n ForeColor =8355711\r\n Name =\"favorite_color_Label\"\r\n Caption =\"favorite_color\"\r\n Tag =\"DetachedLabel\"\r\n GridlineStyleBottom =1\r\n GridlineColor =10921638\r\n LayoutCachedLeft =7680\r\n LayoutCachedTop =60\r\n LayoutCachedWidth =11340\r\n LayoutCachedHeight =375\r\n End\r\n End\r\n End\r\n Begin Section\r\n KeepTogether = NotDefault\r\n Height =450\r\n Name =\"Detail\"\r\n AutoHeight =1\r\n AlternateBackColor =15921906\r\n AlternateBackThemeColorIndex =1\r\n AlternateBackShade =95.0\r\n BackThemeColorIndex =1\r\n Begin\r\n Begin TextBox\r\n OldBorderStyle =0\r\n OverlapFlags =4\r\n IMESentenceMode =3\r\n Left =360\r\n Top =60\r\n Width =7260\r\n Height =330\r\n BorderColor =10921638\r\n ForeColor =4210752\r\n Name =\"full_name\"\r\n ControlSource =\"full_name\"\r\n GridlineColor =10921638\r\n\r\n LayoutCachedLeft =360\r\n LayoutCachedTop =60\r\n LayoutCachedWidth =7620\r\n LayoutCachedHeight =390\r\n End\r\n Begin ComboBox\r\n LimitToList = NotDefault\r\n OverlapFlags =4\r\n IMESentenceMode =3\r\n ColumnCount =2\r\n ListWidth =1440\r\n Left =7680\r\n Top =60\r\n Width =3660\r\n Height =330\r\n TabIndex =1\r\n BorderColor =10921638\r\n ForeColor =4138256\r\n ColumnInfo =\"\\\"\\\";\\\"\\\";\\\"\\\";\\\"\\\";\\\"10\\\";\\\"30\\\"\"\r\n Name =\"favorite_color\"\r\n ControlSource =\"favorite_color\"\r\n RowSourceType =\"Table/Query\"\r\n RowSource =\"SELECT [color_lookup].[id], [color_lookup].[color] FROM color_lookup ORDER BY [i\"\r\n \"d]; \"\r\n ColumnWidths =\"0;1440\"\r\n GridlineColor =10921638\r\n\r\n LayoutCachedLeft =7680\r\n LayoutCachedTop =60\r\n LayoutCachedWidth =11340\r\n LayoutCachedHeight =390\r\n End\r\n End\r\n End\r\n Begin PageFooter\r\n Height =570\r\n Name =\"PageFooterSection\"\r\n AutoHeight =1\r\n AlternateBackThemeColorIndex =1\r\n AlternateBackShade =95.0\r\n BackThemeColorIndex =1\r\n Begin\r\n Begin TextBox\r\n OldBorderStyle =0\r\n OverlapFlags =4\r\n TextAlign =1\r\n IMESentenceMode =3\r\n Left =60\r\n Top =240\r\n Width =5040\r\n Height =330\r\n BorderColor =10921638\r\n ForeColor =4210752\r\n Name =\"Text5\"\r\n ControlSource =\"=Now()\"\r\n Format =\"Long Date\"\r\n GridlineColor =10921638\r\n\r\n LayoutCachedLeft =60\r\n LayoutCachedTop =240\r\n LayoutCachedWidth =5100\r\n LayoutCachedHeight =570\r\n End\r\n Begin TextBox\r\n OldBorderStyle =0\r\n OverlapFlags =4\r\n TextAlign =3\r\n IMESentenceMode =3\r\n Left =6300\r\n Top =240\r\n Width =5040\r\n Height =330\r\n TabIndex =1\r\n BorderColor =10921638\r\n ForeColor =4210752\r\n Name =\"Text6\"\r\n ControlSource =\"=\\\"Page \\\" & [Page] & \\\" of \\\" & [Pages]\"\r\n GridlineColor =10921638\r\n\r\n LayoutCachedLeft =6300\r\n LayoutCachedTop =240\r\n LayoutCachedWidth =11340\r\n LayoutCachedHeight =570\r\n End\r\n End\r\n End\r\n Begin FormFooter\r\n KeepTogether = NotDefault\r\n Height =0\r\n Name =\"ReportFooter\"\r\n AutoHeight =1\r\n AlternateBackThemeColorIndex =1\r\n AlternateBackShade =95.0\r\n BackThemeColorIndex =1\r\n End\r\n End\r\nEnd\r\n"
},
{
"path": "demo/source/reports/people.pv",
"content": "1\r\n9\r\n2969\r\n2100\r\n100\r\n"
},
{
"path": "demo/source/tables/RelationTbl1.txt",
"content": "PK\tF1\tF2\r\n1\t1\t1\r\n2\t2\t2\r\n3\t3\t3\r\n4\t4\t4\r\n5\t5\t5\r\n"
},
{
"path": "demo/source/tables/RelationTbl2.txt",
"content": "PK\tF1\tF2\r\n1-1\t1\t1-1\r\n1-2\t1\t1-2\r\n2-1\t2\t2-1\r\n2-2\t2\t2-2\r\n3-1\t3\t3-1\r\n3-2\t3\t3-2\r\n"
},
{
"path": "demo/source/tables/color_lookup.txt",
"content": "id\tcolor\r\n0\tblack\r\n1\tblue\r\n2\tgreen\r\n3\tcyan\r\n4\tred\r\n5\tmagenta\r\n6\tyellow\r\n7\twhite\r\n"
},
{
"path": "demo/source/tables/people.txt",
"content": "id\tfull_name\tfavorite_color\r\n1\talice\t4\r\n2\tbob\t5\r\n"
},
{
"path": "demo/source/tables/unicode_test_lookup.txt",
"content": "id\tvalue\r\n1\tRésumé\r\n2\tTromsø\r\n"
},
{
"path": "demo/source/tbldef/RelationTbl1.sql",
"content": "CREATE TABLE [RelationTbl1] (\r\n [PK] VARCHAR (255) CONSTRAINT [PrimaryKey] PRIMARY KEY UNIQUE NOT NULL ,\r\n [F1] VARCHAR (255),\r\n [F2] VARCHAR (255)\r\n)\r\n"
},
{
"path": "demo/source/tbldef/RelationTbl2.sql",
"content": "CREATE TABLE [RelationTbl2] (\r\n [PK] VARCHAR (255) CONSTRAINT [PrimaryKey] PRIMARY KEY UNIQUE NOT NULL ,\r\n [F1] VARCHAR (255),\r\n [F2] VARCHAR (255)\r\n)\r\n"
},
{
"path": "demo/source/tbldef/color_lookup.sql",
"content": "CREATE TABLE [color_lookup] (\r\n [id] LONG CONSTRAINT [PrimaryKey] PRIMARY KEY UNIQUE NOT NULL ,\r\n [color] VARCHAR (15)\r\n)\r\n"
},
{
"path": "demo/source/tbldef/people.sql",
"content": "CREATE TABLE [people] (\r\n [id] AUTOINCREMENT CONSTRAINT [PrimaryKey] PRIMARY KEY UNIQUE NOT NULL ,\r\n [full_name] VARCHAR (100),\r\n [favorite_color] LONG \r\n)\r\n"
},
{
"path": "demo/source/tbldef/unicode_test_lookup.sql",
"content": "CREATE TABLE [unicode_test_lookup] (\r\n [id] LONG CONSTRAINT [PrimaryKey] PRIMARY KEY UNIQUE NOT NULL ,\r\n [value] VARCHAR (100)\r\n)\r\n"
}
]