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