|
|
@@ -1,687 +0,0 @@
|
|
|
-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 include_tables As String
|
|
|
-
|
|
|
-' This is used in ImportAllSource
|
|
|
-Private Const DebugOutput As Boolean = False
|
|
|
-'this is used in ExportAllSource
|
|
|
-'Causes the VCS_ and OA_ modules to be exported
|
|
|
-Private Const ArchiveMyself As Boolean = False
|
|
|
-
|
|
|
-
|
|
|
-'returns true if named module is NOT part of the VCS / OA code
|
|
|
-Private Function IsNotVCS(ByVal name As String) As Boolean
|
|
|
-
|
|
|
- '*** if OA addin is used from its developement version (OA exporting itself)
|
|
|
- If CurrentProject.name = "openaccess.accda" Then
|
|
|
- IsNotVCS = True
|
|
|
- Exit Function
|
|
|
- End If
|
|
|
- '****
|
|
|
-
|
|
|
- If name <> "OA_Controls" And _
|
|
|
- name <> "OA_Log" And _
|
|
|
- name <> "OA_Main" And _
|
|
|
- name <> "OA_Optimizer" And _
|
|
|
- name <> "OA_Properties" And _
|
|
|
- name <> "OA_Shell" And _
|
|
|
- name <> "OA_Utils" And _
|
|
|
- name <> "VCS_DataMacro" And _
|
|
|
- name <> "VCS_Dir" And _
|
|
|
- name <> "VCS_File" And _
|
|
|
- name <> "VCS_IE_Functions" And _
|
|
|
- name <> "VCS_ImportExport" And _
|
|
|
- name <> "VCS_Reference" And _
|
|
|
- name <> "VCS_Relation" And _
|
|
|
- name <> "VCS_Report" And _
|
|
|
- name <> "VCS_String" And _
|
|
|
- name <> "VCS_Table" Then
|
|
|
- IsNotVCS = True
|
|
|
- Else
|
|
|
- IsNotVCS = False
|
|
|
- End If
|
|
|
-
|
|
|
-End Function
|
|
|
-
|
|
|
-' Main entry point for EXPORT. Export all forms, reports, queries,
|
|
|
-' macros, modules, and lookup tables to `source` folder under the
|
|
|
-' database's folder.
|
|
|
-Public Sub ExportAllSource()
|
|
|
- Dim db As Object ' DAO.Database
|
|
|
- Dim source_path As String
|
|
|
- Dim obj_path As String
|
|
|
- Dim qry As Object ' DAO.QueryDef
|
|
|
- Dim doc As Object ' DAO.Document
|
|
|
- Dim obj_type As Variant
|
|
|
- Dim obj_type_split() As String
|
|
|
- Dim obj_type_label As String
|
|
|
- Dim obj_type_name As String
|
|
|
- Dim obj_type_num As Integer
|
|
|
- Dim obj_count As Integer
|
|
|
- Dim obj_data_count As Integer
|
|
|
- Dim ucs2 As Boolean
|
|
|
- Dim full_path As String
|
|
|
-
|
|
|
- logger "ExportAllSource", "INFO", "Begin 'Export all sources'"
|
|
|
-
|
|
|
- include_tables = get_include_tables()
|
|
|
-
|
|
|
- logger "ExportAllSource", "DEBUG", "Include_tables: " & include_tables
|
|
|
- logger "ExportAllSource", "DEBUG", "Optimizer on: " & optimizer_activated()
|
|
|
-
|
|
|
- logger "ExportAllSource", "DEBUG", "Save project"
|
|
|
-
|
|
|
- SaveProject
|
|
|
-
|
|
|
- Set db = CurrentDb
|
|
|
-
|
|
|
- CloseFormsReports
|
|
|
- 'InitUsingUcs2
|
|
|
-
|
|
|
- source_path = VCS_Dir.ProjectPath() & "source\"
|
|
|
- logger "ExportAllSource", "DEBUG", "source_path: " & source_path
|
|
|
-
|
|
|
- VCS_Dir.MkDirIfNotExist source_path
|
|
|
-
|
|
|
- Call ExportProperties(CurrentDb, source_path & "database.properties")
|
|
|
-
|
|
|
- obj_path = source_path & "queries\"
|
|
|
- VCS_Dir.ClearTextFilesFromDir obj_path, "bas"
|
|
|
-
|
|
|
- logger "ExportAllSource", "INFO", "Exporting queries..."
|
|
|
-
|
|
|
- obj_count = 0
|
|
|
- For Each qry In db.QueryDefs
|
|
|
-
|
|
|
- '### 11/10/2016: add optimizer
|
|
|
- If optimizer_activated() Then
|
|
|
- If Not needs_export(acQuery, qry.name) > 0 Then
|
|
|
- logger "ExportProperties", "DEBUG", "Query " & qry.name & " skipped"
|
|
|
- obj_count = obj_count + 1
|
|
|
- GoTo next_qry
|
|
|
- End If
|
|
|
- End If
|
|
|
- '###
|
|
|
-
|
|
|
- DoEvents
|
|
|
- If Left$(qry.name, 1) <> "~" Then
|
|
|
- full_path = obj_path & VCS_IE_Functions.to_filename(qry.name) & ".bas"
|
|
|
- VCS_IE_Functions.ExportObject acQuery, qry.name, full_path, VCS_File.UsingUcs2
|
|
|
- obj_count = obj_count + 1
|
|
|
- End If
|
|
|
-
|
|
|
-next_qry:
|
|
|
- Call SysCmd(4, "Export query: " & obj_count & " on " & db.QueryDefs.count)
|
|
|
- Next
|
|
|
- logger "ExportAllSource", "INFO", "> " & obj_count & " queries exported"
|
|
|
-
|
|
|
-
|
|
|
- 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
|
|
|
-
|
|
|
- 'a retirer
|
|
|
- VCS_Dir.ClearTextFilesFromDir obj_path, "bas"
|
|
|
-
|
|
|
- logger "ExportAllSource", "INFO", "Exporting " & obj_type_label & "..."
|
|
|
-
|
|
|
- For Each doc In db.Containers(obj_type_name).Documents
|
|
|
-
|
|
|
- '### 11/10/2016: add optimizer
|
|
|
- If optimizer_activated() Then
|
|
|
- If Not needs_export(obj_type_num, doc.name) > 0 Then
|
|
|
- obj_count = obj_count + 1
|
|
|
- Call SysCmd(4, "Exporting " & obj_type_label & ": " & obj_count & " on " & db.Containers(obj_type_name).Documents.count)
|
|
|
- logger "ExportAllSource", "DEBUG", obj_type_label & " '" & doc.name & " skipped"
|
|
|
- GoTo next_doc
|
|
|
- End If
|
|
|
- End If
|
|
|
- '###
|
|
|
-
|
|
|
- DoEvents
|
|
|
-
|
|
|
- If (Left$(doc.name, 1) <> "~") And _
|
|
|
- (IsNotVCS(doc.name) Or ArchiveMyself) Then
|
|
|
-
|
|
|
- If obj_type_label = "modules" Then
|
|
|
- ucs2 = False
|
|
|
- Else
|
|
|
- ucs2 = VCS_File.UsingUcs2
|
|
|
- End If
|
|
|
-
|
|
|
- full_path = obj_path & VCS_IE_Functions.to_filename(doc.name) & ".bas"
|
|
|
- VCS_IE_Functions.ExportObject obj_type_num, doc.name, full_path, ucs2
|
|
|
-
|
|
|
- If obj_type_label = "reports" Then
|
|
|
- full_path = obj_path & VCS_IE_Functions.to_filename(doc.name) & ".pv"
|
|
|
- VCS_Report.ExportPrintVars doc.name, obj_path & doc.name & ".pv"
|
|
|
- End If
|
|
|
-
|
|
|
- Call SysCmd(4, "Exporting " & obj_type_label & ": " & obj_count & " on " & db.Containers(obj_type_name).Documents.count)
|
|
|
-
|
|
|
- obj_count = obj_count + 1
|
|
|
- End If
|
|
|
-
|
|
|
-next_doc:
|
|
|
- Next
|
|
|
-
|
|
|
- logger "ExportAllSource", "INFO", "> " & obj_count & " " & obj_type_label & " exported"
|
|
|
-
|
|
|
- Next
|
|
|
-
|
|
|
- Call SysCmd(4, "Exporting references")
|
|
|
- VCS_Reference.ExportReferences source_path
|
|
|
-
|
|
|
-'-------------------------table export------------------------
|
|
|
-
|
|
|
- Call SysCmd(4, "Exporting tables")
|
|
|
- obj_path = source_path & "tables\"
|
|
|
- VCS_Dir.MkDirIfNotExist Left$(obj_path, InStrRev(obj_path, "\"))
|
|
|
- VCS_Dir.ClearTextFilesFromDir obj_path, "txt", True
|
|
|
-
|
|
|
- Dim td As DAO.TableDef
|
|
|
- Dim tds As DAO.TableDefs
|
|
|
- Set tds = db.TableDefs
|
|
|
-
|
|
|
- obj_type_label = "tbldef"
|
|
|
- obj_type_name = "Table_Def"
|
|
|
- obj_type_num = acTable
|
|
|
- obj_path = source_path & obj_type_label & "\"
|
|
|
- obj_count = 0
|
|
|
- obj_data_count = 0
|
|
|
- VCS_Dir.MkDirIfNotExist Left$(obj_path, InStrRev(obj_path, "\"))
|
|
|
-
|
|
|
- 'move these into Table and DataMacro modules?
|
|
|
- ' - We don't want to determin file extentions here - or obj_path either!
|
|
|
- VCS_Dir.ClearTextFilesFromDir obj_path, "sql"
|
|
|
- VCS_Dir.ClearTextFilesFromDir obj_path, "xml"
|
|
|
- VCS_Dir.ClearTextFilesFromDir obj_path, "LNKD"
|
|
|
-
|
|
|
- Dim IncludeTablesCol As Collection
|
|
|
- Set IncludeTablesCol = StrSetToCol(include_tables, ",")
|
|
|
-
|
|
|
- logger "ExportAllSource", "INFO", "Exporting " & obj_type_label & "..."
|
|
|
-
|
|
|
- Dim update_this_tabledef As Boolean
|
|
|
-
|
|
|
- For Each td In tds
|
|
|
-
|
|
|
- '### 11/10/2016: add optimizer
|
|
|
- 'only update the table definition if this is a complete export
|
|
|
- 'or if the table definition has been modified since last export
|
|
|
- update_this_tabledef = (Not optimizer_activated() Or needs_export(acTable, td.name) > 0)
|
|
|
- '###
|
|
|
-
|
|
|
- ' 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
|
|
|
-
|
|
|
- If update_this_tabledef Then
|
|
|
- VCS_Table.ExportTableDef db, td, obj_path
|
|
|
- Else
|
|
|
- logger "ExportAllSource", "DEBUG", "TableDef " & td.name & " skipped"
|
|
|
- End If
|
|
|
-
|
|
|
- If include_tables = "*" Then
|
|
|
- DoEvents
|
|
|
- VCS_Table.ExportTableData CStr(td.name), source_path & "tables\"
|
|
|
- If Len(dir$(source_path & "tables\" & td.name & ".txt")) > 0 Then
|
|
|
- obj_data_count = obj_data_count + 1
|
|
|
- End If
|
|
|
- ElseIf (Len(Replace(include_tables, " ", vbNullString)) > 0) And include_tables <> "*" Then
|
|
|
- DoEvents
|
|
|
- On Error GoTo Err_TableNotFound
|
|
|
- If InCollection(IncludeTablesCol, td.name) Then
|
|
|
- VCS_Table.ExportTableData CStr(td.name), source_path & "tables\"
|
|
|
- obj_data_count = obj_data_count + 1
|
|
|
- End If
|
|
|
-Err_TableNotFound:
|
|
|
-
|
|
|
- 'else don't export table data
|
|
|
- End If
|
|
|
- Else
|
|
|
- If update_this_tabledef Then
|
|
|
- VCS_Table.ExportLinkedTable td.name, obj_path
|
|
|
- Else
|
|
|
- logger "ExportAllSource", "DEBUG", "TableDef " & td.name & " skipped"
|
|
|
- End If
|
|
|
- End If
|
|
|
-
|
|
|
- obj_count = obj_count + 1
|
|
|
-
|
|
|
- Call SysCmd(4, "Export table definition: " & obj_count & " on " & tds.count)
|
|
|
-
|
|
|
- End If
|
|
|
-
|
|
|
-next_td:
|
|
|
- Next
|
|
|
- logger "ExportAllSource", "INFO", "> " & obj_count & " tbldef exported"
|
|
|
- logger "ExportAllSource", "INFO", "> " & obj_data_count & " table's datas exported"
|
|
|
-
|
|
|
- logger "ExportAllSource", "INFO", "Export relations"
|
|
|
-
|
|
|
- obj_count = 0
|
|
|
- obj_path = source_path & "relations\"
|
|
|
- VCS_Dir.MkDirIfNotExist Left$(obj_path, InStrRev(obj_path, "\"))
|
|
|
-
|
|
|
- VCS_Dir.ClearTextFilesFromDir obj_path, "txt", True
|
|
|
-
|
|
|
- Dim aRelation As DAO.Relation
|
|
|
-
|
|
|
- Call SysCmd(4, "Exporting relations")
|
|
|
- For Each aRelation In CurrentDb.Relations
|
|
|
- ' Exclude relations from system tables and inherited (linked) relations
|
|
|
- If Not (aRelation.name = "MSysNavPaneGroupsMSysNavPaneGroupToObjects" _
|
|
|
- Or aRelation.name = "MSysNavPaneGroupCategoriesMSysNavPaneGroups" _
|
|
|
- Or (aRelation.Attributes And DAO.RelationAttributeEnum.dbRelationInherited) = _
|
|
|
- DAO.RelationAttributeEnum.dbRelationInherited) Then
|
|
|
-
|
|
|
- VCS_Relation.ExportRelation aRelation, obj_path & to_filename(aRelation.name) & ".txt"
|
|
|
-
|
|
|
- obj_count = obj_count + 1
|
|
|
- End If
|
|
|
- Next
|
|
|
-
|
|
|
- logger "ExportAllSource", "INFO", "> " & obj_count & " relations exported"
|
|
|
-
|
|
|
-
|
|
|
- logger "ExportAllSource", "INFO", "Export done"
|
|
|
-End Sub
|
|
|
-
|
|
|
-
|
|
|
-' Main entry point for IMPORT. Import all forms, reports, queries,
|
|
|
-' macros, modules, and lookup tables from `source` folder under the
|
|
|
-' database's folder.
|
|
|
-Public Sub ImportAllSource()
|
|
|
- Dim FSO As Object
|
|
|
- Dim source_path As String
|
|
|
- Dim obj_path As String
|
|
|
- Dim obj_type As Variant
|
|
|
- Dim obj_type_split() As String
|
|
|
- Dim obj_type_label As String
|
|
|
- Dim obj_type_num As Integer
|
|
|
- Dim obj_count As Integer
|
|
|
- Dim filename As String
|
|
|
- Dim obj_name As String
|
|
|
- Dim ucs2 As Boolean
|
|
|
-
|
|
|
- logger "ImportAllSource", "INFO", "Begin 'Import all sources'"
|
|
|
- logger "ImportAllSource", "DEBUG", "Optimizer on: " & optimizer_activated()
|
|
|
-
|
|
|
- Set FSO = CreateObject("Scripting.FileSystemObject")
|
|
|
-
|
|
|
- CloseFormsReports
|
|
|
- 'InitUsingUcs2
|
|
|
-
|
|
|
- source_path = VCS_Dir.ProjectPath() & "source\"
|
|
|
- If Not FSO.FolderExists(source_path) Then
|
|
|
- logger "ImportAllSource", "CRITICAL", "No source found at:" & source_path
|
|
|
- End If
|
|
|
-
|
|
|
- Call ImportProperties(CurrentDb, source_path & "database.properties")
|
|
|
-
|
|
|
- If Not VCS_Reference.ImportReferences(source_path) Then
|
|
|
- logger "ImportAllSource", "INFO", "Info: no references file in " & source_path
|
|
|
- End If
|
|
|
-
|
|
|
- obj_path = source_path & "queries\"
|
|
|
- filename = dir$(obj_path & "*.bas")
|
|
|
-
|
|
|
- Dim tempFilePath As String
|
|
|
- tempFilePath = VCS_File.TempFile()
|
|
|
-
|
|
|
- If Len(filename) > 0 Then
|
|
|
- logger "ImportAllSource", "INFO", "Importing queries..."
|
|
|
- obj_count = 0
|
|
|
- Do Until Len(filename) = 0
|
|
|
- DoEvents
|
|
|
- obj_name = Mid$(filename, 1, InStrRev(filename, ".") - 1)
|
|
|
- obj_name = VCS_IE_Functions.to_accessname(obj_name)
|
|
|
- VCS_IE_Functions.ImportObject acQuery, obj_name, obj_path & filename, VCS_File.UsingUcs2
|
|
|
- VCS_IE_Functions.ExportObject acQuery, obj_name, tempFilePath, VCS_File.UsingUcs2
|
|
|
- VCS_IE_Functions.ImportObject acQuery, obj_name, tempFilePath, VCS_File.UsingUcs2
|
|
|
- obj_count = obj_count + 1
|
|
|
- filename = dir$()
|
|
|
- Loop
|
|
|
- logger "ImportAllSource", "INFO", "> " & obj_count & " queries imported"
|
|
|
- End If
|
|
|
-
|
|
|
- VCS_Dir.DelIfExist tempFilePath
|
|
|
-
|
|
|
- ' restore table definitions
|
|
|
- obj_path = source_path & "tbldef\"
|
|
|
- filename = dir$(obj_path & "*.sql")
|
|
|
- If Len(filename) > 0 Then
|
|
|
- logger "ImportAllSource", "INFO", "Importing TblDefs..."
|
|
|
- obj_count = 0
|
|
|
- Do Until Len(filename) = 0
|
|
|
- obj_name = Mid$(filename, 1, InStrRev(filename, ".") - 1)
|
|
|
- obj_name = VCS_IE_Functions.to_accessname(obj_name)
|
|
|
- VCS_Table.ImportTableDef CStr(obj_name), obj_path
|
|
|
- obj_count = obj_count + 1
|
|
|
- filename = dir$()
|
|
|
- Loop
|
|
|
- logger "ImportAllSource", "INFO", "> " & obj_count & " TblDefs imported"
|
|
|
- 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
|
|
|
- logger "ImportAllSource", "INFO", "Importing Linked TblDefs..."
|
|
|
- obj_count = 0
|
|
|
- Do Until Len(filename) = 0
|
|
|
- obj_name = Mid$(filename, 1, InStrRev(filename, ".") - 1)
|
|
|
- obj_name = VCS_IE_Functions.to_accessname(obj_name)
|
|
|
- VCS_Table.ImportLinkedTable CStr(obj_name), obj_path
|
|
|
- obj_count = obj_count + 1
|
|
|
- filename = dir$()
|
|
|
- Loop
|
|
|
- logger "ImportAllSource", "INFO", "> " & obj_count & " Linked TblDefs imported"
|
|
|
- End If
|
|
|
-
|
|
|
- ' NOW we may load data
|
|
|
- obj_path = source_path & "tables\"
|
|
|
- filename = dir$(obj_path & "*.txt")
|
|
|
- If Len(filename) > 0 Then
|
|
|
- logger "ImportAllSource", "INFO", "Importing table's data..."
|
|
|
- obj_count = 0
|
|
|
- Do Until Len(filename) = 0
|
|
|
- DoEvents
|
|
|
- obj_name = Mid$(filename, 1, InStrRev(filename, ".") - 1)
|
|
|
- obj_name = VCS_IE_Functions.to_accessname(obj_name)
|
|
|
- VCS_Table.ImportTableData CStr(obj_name), obj_path
|
|
|
- obj_count = obj_count + 1
|
|
|
- filename = dir$()
|
|
|
- Loop
|
|
|
- logger "ImportAllSource", "INFO", "> " & obj_count & " table's data imported"
|
|
|
- End If
|
|
|
-
|
|
|
- 'load Data Macros - not DRY!
|
|
|
- obj_path = source_path & "tbldef\"
|
|
|
- filename = dir$(obj_path & "*.xml")
|
|
|
- If Len(filename) > 0 Then
|
|
|
- logger "ImportAllSource", "INFO", "Importing Data Macros..."
|
|
|
- obj_count = 0
|
|
|
- Do Until Len(filename) = 0
|
|
|
- DoEvents
|
|
|
- obj_name = Mid$(filename, 1, InStrRev(filename, ".") - 1)
|
|
|
- obj_name = VCS_IE_Functions.to_accessname(obj_name)
|
|
|
- 'VCS_Table.ImportTableData CStr(obj_name), obj_path
|
|
|
- VCS_DataMacro.ImportDataMacros obj_name, obj_path
|
|
|
- obj_count = obj_count + 1
|
|
|
- filename = dir$()
|
|
|
- Loop
|
|
|
- logger "ImportAllSource", "INFO", "> " & obj_count & " DataMacros imported"
|
|
|
- End If
|
|
|
-
|
|
|
- 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
|
|
|
- logger "ImportAllSource", "INFO", "Importing " & obj_type_label & "..."
|
|
|
- obj_count = 0
|
|
|
- Do Until Len(filename) = 0
|
|
|
- ' DoEvents no good idea!
|
|
|
- obj_name = Mid$(filename, 1, InStrRev(filename, ".") - 1)
|
|
|
- obj_name = VCS_IE_Functions.to_accessname(obj_name)
|
|
|
- If obj_type_label = "modules" Then
|
|
|
- ucs2 = False
|
|
|
- Else
|
|
|
- ucs2 = VCS_File.UsingUcs2
|
|
|
- End If
|
|
|
- If IsNotVCS(obj_name) Then
|
|
|
- VCS_IE_Functions.ImportObject obj_type_num, obj_name, obj_path & filename, ucs2
|
|
|
- obj_count = obj_count + 1
|
|
|
- Else
|
|
|
- If ArchiveMyself Then
|
|
|
- logger "ImportAllSource", "WARNING", "Module " & obj_name & " could not be updated while running. Ensure latest version is included!"
|
|
|
- End If
|
|
|
- End If
|
|
|
- filename = dir$()
|
|
|
- Loop
|
|
|
- logger "ImportAllSource", "INFO", "> " & obj_count & " " & obj_type_label & " imported"
|
|
|
-
|
|
|
- End If
|
|
|
-
|
|
|
- Next
|
|
|
-
|
|
|
- 'import Print Variables
|
|
|
- logger "ImportAllSource", "INFO", "Importing Print Vars..."
|
|
|
- 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)
|
|
|
- obj_name = VCS_IE_Functions.to_accessname(obj_name)
|
|
|
- VCS_Report.ImportPrintVars obj_name, obj_path & filename
|
|
|
- obj_count = obj_count + 1
|
|
|
- filename = dir$()
|
|
|
- Loop
|
|
|
- logger "ImportAllSource", "INFO", "> " & obj_count & " Print Vars imported"
|
|
|
-
|
|
|
- 'import relations
|
|
|
- logger "ImportAllSource", "INFO", "Importing Relations..."
|
|
|
- obj_count = 0
|
|
|
- obj_path = source_path & "relations\"
|
|
|
- filename = dir$(obj_path & "*.txt")
|
|
|
- Do Until Len(filename) = 0
|
|
|
- DoEvents
|
|
|
- VCS_Relation.ImportRelation obj_path & filename
|
|
|
- obj_count = obj_count + 1
|
|
|
- filename = dir$()
|
|
|
- Loop
|
|
|
- logger "ImportAllSource", "INFO", "> " & obj_count & " Relations imported"
|
|
|
- DoEvents
|
|
|
-
|
|
|
- logger "ImportAllSource", "INFO", "Import Done"
|
|
|
-End Sub
|
|
|
-
|
|
|
-' Main entry point for ImportProject.
|
|
|
-' Drop all forms, reports, queries, macros, modules.
|
|
|
-' execute ImportAllSource.
|
|
|
-Public Sub ImportProject()
|
|
|
-On Error GoTo errorHandler
|
|
|
-
|
|
|
- If OA_MsgBox("This action will delete all existing: " & vbCrLf & _
|
|
|
- vbCrLf & _
|
|
|
- Chr$(149) & " Tables" & vbCrLf & _
|
|
|
- Chr$(149) & " Forms" & vbCrLf & _
|
|
|
- Chr$(149) & " Macros" & vbCrLf & _
|
|
|
- Chr$(149) & " Modules" & vbCrLf & _
|
|
|
- Chr$(149) & " Queries" & vbCrLf & _
|
|
|
- Chr$(149) & " Reports" & vbCrLf & _
|
|
|
- vbCrLf & _
|
|
|
- "Are you sure you want to proceed?", vbCritical + vbYesNo, _
|
|
|
- "Import Project") <> vbYes Then
|
|
|
- Exit Sub
|
|
|
- End If
|
|
|
-
|
|
|
- Dim db As DAO.Database
|
|
|
- Set db = CurrentDb
|
|
|
- CloseFormsReports
|
|
|
-
|
|
|
- Debug.Print
|
|
|
- Debug.Print "Deleting Existing Objects"
|
|
|
- Debug.Print
|
|
|
-
|
|
|
- Dim rel As DAO.Relation
|
|
|
- For Each rel In CurrentDb.Relations
|
|
|
- If Not (rel.name = "MSysNavPaneGroupsMSysNavPaneGroupToObjects" Or _
|
|
|
- rel.name = "MSysNavPaneGroupCategoriesMSysNavPaneGroups") Then
|
|
|
- CurrentDb.Relations.Delete (rel.name)
|
|
|
- End If
|
|
|
- Next
|
|
|
-
|
|
|
- Dim dbObject As Object
|
|
|
- For Each dbObject In db.QueryDefs
|
|
|
- DoEvents
|
|
|
- If Left$(dbObject.name, 1) <> "~" Then
|
|
|
-' Debug.Print dbObject.Name
|
|
|
- db.QueryDefs.Delete dbObject.name
|
|
|
- End If
|
|
|
- Next
|
|
|
-
|
|
|
- Dim td As DAO.TableDef
|
|
|
- For Each td In CurrentDb.TableDefs
|
|
|
- If Left$(td.name, 4) <> "MSys" And _
|
|
|
- Left$(td.name, 1) <> "~" Then
|
|
|
- CurrentDb.TableDefs.Delete (td.name)
|
|
|
- End If
|
|
|
- Next
|
|
|
-
|
|
|
- Dim objType As Variant
|
|
|
- Dim objTypeArray() As String
|
|
|
- Dim doc As Object
|
|
|
- '
|
|
|
- ' Object Type Constants
|
|
|
- Const OTNAME As Byte = 0
|
|
|
- Const OTID As Byte = 1
|
|
|
-
|
|
|
- For Each objType In Split( _
|
|
|
- "Forms|" & acForm & "," & _
|
|
|
- "Reports|" & acReport & "," & _
|
|
|
- "Scripts|" & acMacro & "," & _
|
|
|
- "Modules|" & acModule _
|
|
|
- , "," _
|
|
|
- )
|
|
|
- objTypeArray = Split(objType, "|")
|
|
|
- DoEvents
|
|
|
- For Each doc In db.Containers(objTypeArray(OTNAME)).Documents
|
|
|
- DoEvents
|
|
|
- If (Left$(doc.name, 1) <> "~") And _
|
|
|
- (IsNotVCS(doc.name)) Then
|
|
|
-' Debug.Print doc.Name
|
|
|
- DoCmd.DeleteObject objTypeArray(OTID), doc.name
|
|
|
- End If
|
|
|
- Next
|
|
|
- Next
|
|
|
-
|
|
|
- Debug.Print "================="
|
|
|
- Debug.Print "Importing Project"
|
|
|
- ImportAllSource
|
|
|
-
|
|
|
- Exit Sub
|
|
|
-
|
|
|
-errorHandler:
|
|
|
- Debug.Print "VCS_ImportExport.ImportProject: Error #" & err.Number & vbCrLf & _
|
|
|
- err.Description
|
|
|
-End Sub
|
|
|
-
|
|
|
-' Expose for use as function, can be called by query
|
|
|
-Public Sub make()
|
|
|
- ImportProject
|
|
|
-End Sub
|
|
|
-
|
|
|
-
|
|
|
-
|
|
|
-'===================================================================================================================================
|
|
|
-'-----------------------------------------------------------'
|
|
|
-' Helper Functions - these should be put in their own files '
|
|
|
-'-----------------------------------------------------------'
|
|
|
-
|
|
|
-' Close all open forms.
|
|
|
-Private Sub CloseFormsReports()
|
|
|
- On Error GoTo errorHandler
|
|
|
- logger "CloseFormsReports", "DEBUG", "Close any opened form or report"
|
|
|
-
|
|
|
- Dim threshold As Integer
|
|
|
- threshold = 0
|
|
|
- Do While Forms.count > threshold
|
|
|
- If Forms(0).name = "OpenAccess" Then
|
|
|
- threshold = 1
|
|
|
- Else
|
|
|
- DoCmd.Close acForm, Forms(threshold).name
|
|
|
- End If
|
|
|
- 'DoEvents
|
|
|
- Loop
|
|
|
- Do While Reports.count > 0
|
|
|
- DoCmd.Close acReport, Reports(0).name
|
|
|
- 'DoEvents
|
|
|
- Loop
|
|
|
-
|
|
|
- DoEvents
|
|
|
- Exit Sub
|
|
|
-
|
|
|
-errorHandler:
|
|
|
- logger "CloseFormsReports", "CRITICAL", "Error #" & err.Number & err.Description
|
|
|
-End Sub
|
|
|
-
|
|
|
-
|
|
|
-'errno 457 - duplicate key (& item)
|
|
|
-Public Function StrSetToCol(ByVal strSet As String, ByVal delimiter As String) As Collection 'throws errors
|
|
|
- Dim strSetArray() As String
|
|
|
- Dim col As Collection
|
|
|
-
|
|
|
- Set col = New Collection
|
|
|
- strSetArray = Split(strSet, delimiter)
|
|
|
-
|
|
|
- Dim item As Variant
|
|
|
- For Each item In strSetArray
|
|
|
- col.Add item, item
|
|
|
- Next
|
|
|
-
|
|
|
- Set StrSetToCol = col
|
|
|
-End Function
|
|
|
-
|
|
|
-
|
|
|
-' Check if an item or key is in a collection
|
|
|
-Public Function InCollection(col As Collection, Optional vItem, Optional vKey) As Boolean
|
|
|
- On Error Resume Next
|
|
|
-
|
|
|
- Dim vColItem As Variant
|
|
|
-
|
|
|
- InCollection = False
|
|
|
-
|
|
|
- If Not IsMissing(vKey) Then
|
|
|
- col.item vKey
|
|
|
-
|
|
|
- '5 if not in collection, it is 91 if no collection exists
|
|
|
- If err.Number <> 5 And err.Number <> 91 Then
|
|
|
- InCollection = True
|
|
|
- End If
|
|
|
- ElseIf Not IsMissing(vItem) Then
|
|
|
- For Each vColItem In col
|
|
|
- If vColItem = vItem Then
|
|
|
- InCollection = True
|
|
|
- GoTo Exit_Proc
|
|
|
- End If
|
|
|
- Next vColItem
|
|
|
- End If
|
|
|
-
|
|
|
-Exit_Proc:
|
|
|
- Exit Function
|
|
|
-Err_Handle:
|
|
|
- Resume Exit_Proc
|
|
|
-End Function
|