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
========================
[](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`.
2. Then click on `Import/Export` then click `import customization file` and open `./UIRibbon/FORM UPDATES.exportedUI`.
# 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
================================================
<mso:cmd app="Access" dt="0" />
<mso:customUI
xmlns:mso="http://schemas.microsoft.com/office/2009/07/customui">
<mso:ribbon>
<mso:qat/>
<mso:tabs>
<mso:tab id="mso_c2.2B507795" label="FORM UPDATES">
<mso:group id="mso_c3.2B507795" label="Dialog" autoScale="true">
<mso:button id="loadvmBtn" label="Load Version Manager"
imageMso="FormsMenu" onAction="loadVCS"/>
<mso:button id="updateFormsBtn" label="Update Forms"
imageMso="RecurrenceEdit" onAction="=subUpdateBtn("updateFormsBtn")"/>
<mso:button id="exportFormsBtn" label="Export Forms"
imageMso="SourceControlCheckOut" onAction="=subUpdateBtn("exportFormsBtn")"/>
<mso:button id="otherFunctionsBtn" label="Other Functions"
imageMso="TrustCenter" onAction="formDialog"/>
</mso:group>
</mso:tab>
</mso:tabs>
</mso:ribbon>
</mso:customUI>
================================================
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:<?xml version=\"1.0\" encoding=\"UTF-16\" standalone=\"no\"?>\015\012<UserI"
"nterfaceMacro MinimumClientDesignVersion=\"14.0.0000.0000\" xmlns=\"http://schem"
"as.microsoft.com/office/accessservices/2009/11/application\" xmlns:a=\"http://sc"
"hemas.microsoft.com/office/acc"
End
Begin
Comment ="_AXL:essservices/2009/11/forms\"><Statements><Action Name=\"MessageBox\"><Argume"
"nt Name=\"Message\">Hello world.</Argument></Action></Statements></UserInterface"
"Macro>"
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)
)
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
SYMBOL INDEX (4 symbols across 4 files) FILE: demo/source/tbldef/RelationTbl1.sql type RelationTbl1 (line 1) | CREATE TABLE [RelationTbl1] ( FILE: demo/source/tbldef/RelationTbl2.sql type RelationTbl2 (line 1) | CREATE TABLE [RelationTbl2] ( FILE: demo/source/tbldef/color_lookup.sql type color_lookup (line 1) | CREATE TABLE [color_lookup] ( FILE: demo/source/tbldef/people.sql type people (line 1) | CREATE TABLE [people] (
Condensed preview — 40 files, each showing path, character count, and a content snippet. Download the .json file or copy for the full structured content (128K chars).
[
{
"path": ".gitattributes",
"chars": 15,
"preview": "text eol=crlf\r\n"
},
{
"path": ".github/FUNDING.yml",
"chars": 612,
"preview": "# These are supported funding model platforms\n\ngithub: # timabell\npatreon: timabell\nopen_collective: # Replace with a si"
},
{
"path": ".gitignore",
"chars": 37,
"preview": "*.komodoproject\n\r\n*.accdb\r\n*.laccdb\r\n"
},
{
"path": "CHANGELOG.md",
"chars": 6031,
"preview": "Change log\n==========\n\nThis change log isn't being kept up to date any more, please see the git history for changes.\n\nVe"
},
{
"path": "LICENSE.txt",
"chars": 852,
"preview": "Copyright © 2012 Brendan Kidwell et al\r\n\r\nUse of msaccess-vcs-integration and documentation are subject to the following"
},
{
"path": "MSAccess-VCS/VCS_Button_Functions.bas",
"chars": 1043,
"preview": "Attribute VB_Name = \"VCS_Button_Functions\"\nOption Compare Database\n\n' function to call update functions from button clic"
},
{
"path": "MSAccess-VCS/VCS_DataMacro.bas",
"chars": 2110,
"preview": "Attribute VB_Name = \"VCS_DataMacro\"\r\nOption Compare Database\r\n\r\nOption Private Module\r\nOption Explicit\r\n\r\n\r\n' For Access"
},
{
"path": "MSAccess-VCS/VCS_Dir.bas",
"chars": 1446,
"preview": "Attribute VB_Name = \"VCS_Dir\"\r\nOption Compare Database\r\n\r\nOption Private Module\r\nOption Explicit\r\n\r\n\r\n' Path/Directory o"
},
{
"path": "MSAccess-VCS/VCS_File.bas",
"chars": 8849,
"preview": "Attribute VB_Name = \"VCS_File\"\r\nOption Compare Database\r\n\r\nOption Private Module\r\nOption Explicit\r\n\r\n#If VBA7 Then\r\n Pr"
},
{
"path": "MSAccess-VCS/VCS_IE_Functions.bas",
"chars": 7892,
"preview": "Attribute VB_Name = \"VCS_IE_Functions\"\r\nOption Compare Database\r\n\r\nOption Private Module\r\nOption Explicit\r\n\r\n#If VBA7 Th"
},
{
"path": "MSAccess-VCS/VCS_ImportExport.bas",
"chars": 28828,
"preview": "Attribute VB_Name = \"VCS_ImportExport\"\r\nOption Compare Database\r\n\r\nOption Explicit\r\n' List of lookup tables that are par"
},
{
"path": "MSAccess-VCS/VCS_Query.bas",
"chars": 4642,
"preview": "Attribute VB_Name = \"VCS_Query\"\r\nOption Compare Database\r\nOption Explicit\r\n\r\nConst StartConnect As String = \"[CONNECT]\"\r"
},
{
"path": "MSAccess-VCS/VCS_Reference.bas",
"chars": 2648,
"preview": "Attribute VB_Name = \"VCS_Reference\"\r\nOption Compare Database\r\n\r\nOption Private Module\r\nOption Explicit\r\n\r\n\r\n' Import Ref"
},
{
"path": "MSAccess-VCS/VCS_Relation.bas",
"chars": 2292,
"preview": "Attribute VB_Name = \"VCS_Relation\"\r\nOption Compare Database\r\n\r\nOption Private Module\r\nOption Explicit\r\n\r\n\r\nPublic Sub VC"
},
{
"path": "MSAccess-VCS/VCS_Report.bas",
"chars": 3741,
"preview": "Attribute VB_Name = \"VCS_Report\"\r\nOption Compare Database\r\n\r\nOption Private Module\r\nOption Explicit\r\n\r\n' ---------------"
},
{
"path": "MSAccess-VCS/VCS_String.bas",
"chars": 1916,
"preview": "Attribute VB_Name = \"VCS_String\"\r\nOption Compare Database\r\n\r\nOption Private Module\r\nOption Explicit\r\n\r\n\r\n'--------------"
},
{
"path": "MSAccess-VCS/VCS_Table.bas",
"chars": 10528,
"preview": "Attribute VB_Name = \"VCS_Table\"\r\nOption Compare Database\r\n\r\nOption Private Module\r\nOption Explicit\r\n\r\n\r\n\r\n\r\n\r\nPublic Sub"
},
{
"path": "README.md",
"chars": 8792,
"preview": "msaccess-vcs-integration\n========================\n\n[![Join the chat at https://gitter.im/timabell/msaccess-vcs-integrati"
},
{
"path": "UIRibbon/FORM UPDATES.exportedUI",
"chars": 1070,
"preview": "<mso:cmd app=\"Access\" dt=\"0\" />\n<mso:customUI \n xmlns:mso=\"http://schemas.microsoft.com/office/2009/07/customui\">\n "
},
{
"path": "VCS_Loader.bas",
"chars": 3125,
"preview": "Attribute VB_Name = \"VCS_Loader\"\r\nOption Compare Database\r\n\r\nOption Explicit\r\n\r\nPublic Sub loadVCS(Optional ByVal Source"
},
{
"path": "VERSION.txt",
"chars": 11,
"preview": "1.0.1_beta\n"
},
{
"path": "demo/README.md",
"chars": 280,
"preview": "demo\\\n=====\n\nDatabases supplied for convenience\n\n`demo.accdb`\n\nUse this for:\n\n* trying out this project\n* for testing up"
},
{
"path": "demo/source/forms/people.bas",
"chars": 7574,
"preview": "Version =20\r\nVersionRequired =20\r\nBegin Form\r\n AutoCenter = NotDefault\r\n DividingLines = NotDefault\r\n AllowDes"
},
{
"path": "demo/source/macros/demo_macro.bas",
"chars": 692,
"preview": "Version =196611\r\nColumnsShown =0\r\nBegin\r\n Action =\"MsgBox\"\r\n Argument =\"Hello world.\"\r\n Argument =\"-1\"\r\n Ar"
},
{
"path": "demo/source/modules/DemoModule.bas",
"chars": 113,
"preview": "Option Compare Database\r\nOption Explicit\r\n\r\nPublic Function DemoHello()\r\nDebug.Print \"Hello world.\"\r\nEnd Function"
},
{
"path": "demo/source/queries/demo_query.bas",
"chars": 1449,
"preview": "Operation =1\r\nOption =0\r\nWhere =\"(((color_lookup.color)=\\\"red\\\"))\"\r\nBegin InputTables\r\n Name =\"people\"\r\n Name =\"c"
},
{
"path": "demo/source/references.csv",
"chars": 177,
"preview": "{000204EF-0000-0000-C000-000000000046},4,1\r\n{4AFFC9A0-5F99-101B-AF4E-00AA003F0F07},9,0\r\n{00020430-0000-0000-C000-0000000"
},
{
"path": "demo/source/relations/RelationTbl1RelationTbl2.txt",
"chars": 88,
"preview": "4352\r\nRelationTbl1RelationTbl2\r\nRelationTbl1\r\nRelationTbl2\r\nField = Begin\r\nPK\r\nF1\r\nEnd\r\n"
},
{
"path": "demo/source/reports/people.bas",
"chars": 9611,
"preview": "Version =20\r\nVersionRequired =20\r\nBegin Report\r\n LayoutForPrint = NotDefault\r\n DividingLines = NotDefault\r\n Al"
},
{
"path": "demo/source/reports/people.pv",
"chars": 23,
"preview": "1\r\n9\r\n2969\r\n2100\r\n100\r\n"
},
{
"path": "demo/source/tables/RelationTbl1.txt",
"chars": 46,
"preview": "PK\tF1\tF2\r\n1\t1\t1\r\n2\t2\t2\r\n3\t3\t3\r\n4\t4\t4\r\n5\t5\t5\r\n"
},
{
"path": "demo/source/tables/RelationTbl2.txt",
"chars": 77,
"preview": "PK\tF1\tF2\r\n1-1\t1\t1-1\r\n1-2\t1\t1-2\r\n2-1\t2\t2-1\r\n2-2\t2\t2-2\r\n3-1\t3\t3-1\r\n3-2\t3\t3-2\r\n"
},
{
"path": "demo/source/tables/color_lookup.txt",
"chars": 82,
"preview": "id\tcolor\r\n0\tblack\r\n1\tblue\r\n2\tgreen\r\n3\tcyan\r\n4\tred\r\n5\tmagenta\r\n6\tyellow\r\n7\twhite\r\n"
},
{
"path": "demo/source/tables/people.txt",
"chars": 50,
"preview": "id\tfull_name\tfavorite_color\r\n1\talice\t4\r\n2\tbob\t5\r\n"
},
{
"path": "demo/source/tables/unicode_test_lookup.txt",
"chars": 31,
"preview": "id\tvalue\r\n1\tRésumé\r\n2\tTromsø\r\n"
},
{
"path": "demo/source/tbldef/RelationTbl1.sql",
"chars": 157,
"preview": "CREATE TABLE [RelationTbl1] (\r\n [PK] VARCHAR (255) CONSTRAINT [PrimaryKey] PRIMARY KEY UNIQUE NOT NULL ,\r\n [F1] VARC"
},
{
"path": "demo/source/tbldef/RelationTbl2.sql",
"chars": 157,
"preview": "CREATE TABLE [RelationTbl2] (\r\n [PK] VARCHAR (255) CONSTRAINT [PrimaryKey] PRIMARY KEY UNIQUE NOT NULL ,\r\n [F1] VARC"
},
{
"path": "demo/source/tbldef/color_lookup.sql",
"chars": 128,
"preview": "CREATE TABLE [color_lookup] (\r\n [id] LONG CONSTRAINT [PrimaryKey] PRIMARY KEY UNIQUE NOT NULL ,\r\n [color] VARCHAR ("
},
{
"path": "demo/source/tbldef/people.sql",
"chars": 162,
"preview": "CREATE TABLE [people] (\r\n [id] AUTOINCREMENT CONSTRAINT [PrimaryKey] PRIMARY KEY UNIQUE NOT NULL ,\r\n [full_name] VAR"
},
{
"path": "demo/source/tbldef/unicode_test_lookup.sql",
"chars": 136,
"preview": "CREATE TABLE [unicode_test_lookup] (\r\n [id] LONG CONSTRAINT [PrimaryKey] PRIMARY KEY UNIQUE NOT NULL ,\r\n [value] VA"
}
]
About this extraction
This page contains the full source code of the timabell/msaccess-vcs-integration GitHub repository, extracted and formatted as plain text for AI agents and large language models (LLMs). The extraction includes 40 files (114.8 KB), approximately 29.2k tokens, and a symbol index with 4 extracted functions, classes, methods, constants, and types. Use this with OpenClaw, Claude, ChatGPT, Cursor, Windsurf, or any other AI tool that accepts text input. You can copy the full output to your clipboard or download it as a .txt file.
Extracted by GitExtract — free GitHub repo to text converter for AI. Built by Nikandr Surkov.