diff --git a/Testing/Testing.accdb.src/forms/frmColors.bas b/Testing/Testing.accdb.src/forms/frmColors.bas index 58dc9e41..0452bc76 100644 --- a/Testing/Testing.accdb.src/forms/frmColors.bas +++ b/Testing/Testing.accdb.src/forms/frmColors.bas @@ -659,10 +659,6 @@ Begin Form PressedColor =6249563 HoverForeColor =4210752 PressedForeColor =4210752 - WebImagePaddingLeft =2 - WebImagePaddingTop =2 - WebImagePaddingRight =1 - WebImagePaddingBottom =1 End Begin CommandButton OverlapFlags =85 @@ -688,10 +684,6 @@ Begin Form PressedColor =6249563 HoverForeColor =4210752 PressedForeColor =4210752 - WebImagePaddingLeft =2 - WebImagePaddingTop =2 - WebImagePaddingRight =1 - WebImagePaddingBottom =1 End Begin CommandButton OverlapFlags =85 @@ -719,10 +711,6 @@ Begin Form PressedColor =6249563 HoverForeColor =4210752 PressedForeColor =4210752 - WebImagePaddingLeft =2 - WebImagePaddingTop =2 - WebImagePaddingRight =1 - WebImagePaddingBottom =1 End Begin CommandButton OverlapFlags =85 @@ -750,10 +738,6 @@ Begin Form PressedColor =6249563 HoverForeColor =4210752 PressedForeColor =4210752 - WebImagePaddingLeft =2 - WebImagePaddingTop =2 - WebImagePaddingRight =1 - WebImagePaddingBottom =1 End Begin CommandButton OverlapFlags =85 @@ -778,10 +762,6 @@ Begin Form PressedColor =6249563 HoverForeColor =4210752 PressedForeColor =4210752 - WebImagePaddingLeft =2 - WebImagePaddingTop =2 - WebImagePaddingRight =1 - WebImagePaddingBottom =1 End Begin CommandButton OverlapFlags =85 @@ -809,10 +789,6 @@ Begin Form PressedColor =6249563 HoverForeColor =4210752 PressedForeColor =4210752 - WebImagePaddingLeft =2 - WebImagePaddingTop =2 - WebImagePaddingRight =1 - WebImagePaddingBottom =1 End Begin Rectangle BackStyle =1 diff --git a/Testing/Testing.accdb.src/forms/frmMain.bas b/Testing/Testing.accdb.src/forms/frmMain.bas index eec7411e..db651d2e 100644 --- a/Testing/Testing.accdb.src/forms/frmMain.bas +++ b/Testing/Testing.accdb.src/forms/frmMain.bas @@ -191,10 +191,6 @@ Begin Form PressedColor =9262658 HoverForeColor =4210752 PressedForeColor =4210752 - WebImagePaddingLeft =2 - WebImagePaddingTop =2 - WebImagePaddingRight =1 - WebImagePaddingBottom =1 Overlaps =1 End Begin ListBox @@ -327,10 +323,6 @@ Begin Form PressedColor =9262658 HoverForeColor =4210752 PressedForeColor =4210752 - WebImagePaddingLeft =2 - WebImagePaddingTop =2 - WebImagePaddingRight =1 - WebImagePaddingBottom =1 Overlaps =1 End Begin Label @@ -398,94 +390,94 @@ Public Sub cmdRunTests_Click() Dim intTest As Integer Dim dbs As DAO.Database Dim rsc As SharedResource - + Set dbs = CurrentDb - + ' Clear list and totals lstResults.RowSource = "" m_Totals(True) = 0 m_Totals(False) = 0 - + ' Ignore any errors. ' NOTE: don't include the test result on a line that may throw an error. On Error Resume Next - + ' Update linked tables/CSV to use the current directory dbs.TableDefs("tblLinkedAccess").Connect = ";DATABASE=" & Application.CurrentProject.Path & "\Testing.accdb" dbs.TableDefs("tblLinkedAccess").RefreshLink dbs.TableDefs("tblLinkedCSV").Connect = "Text;DSN=Linked Link Specification;FMT=Delimited;HDR=NO;IMEX=2;CharacterSet=437;ACCDB=YES;DATABASE=" & Application.CurrentProject.Path dbs.TableDefs("tblLinkedCSV").RefreshLink - + '======================== ' BEGIN TESTS '======================== - + ' Tables strTest = dbs.TableDefs("tblInternal").Name ShowResult "Access Table exists", (strTest = "tblInternal") - + intTest = 0 intTest = DCount("*", "tblInternal") ShowResult "tblInternal has data", (intTest > 0) - + strTest = dbs.TableDefs("tblLinkedCSV").Name ShowResult "Linked Table exists", (strTest = "tblLinkedCSV") intTest = 0 intTest = DCount("*", "tblLinkedCSV") ShowResult "tblLinkedCSV has data", (intTest > 0) - + ShowResult "Saved Table Data (TDF)", FSO.FileExists(ExportFolder & "tables\tblInternal.txt") - + ShowResult "Saved Table Data (XML)", FSO.FileExists(ExportFolder & "tables\tblSaveXML.xml") - + ShowResult "Table SQL", FSO.FileExists(ExportFolder & "tbldefs\tblInternal.sql") ShowResult "Linked Table JSON", FSO.FileExists(ExportFolder & "tbldefs\tblLinkedCSV.json") - + ShowResult "Linked Table structure", FSO.FileExists(ExportFolder & "tbldefs\tblLinkedCSV.sql") intTest = 0 intTest = dbs.Relations("tblInternaltblSaveXML").Fields.Count ShowResult "Table Relationship", (intTest = 1) - + intTest = 0 intTest = DCount("*", "MSysObjects", "Not IsNull(LvExtra) and Type = 1 and [Name] = 'tblSaveXML'") ShowResult "Table Data Macro Exists", (intTest > 0) - - + + ' Queries strTest = dbs.QueryDefs("qryNavigationPaneGroups").Name ShowResult "Query exists", (strTest = "qryNavigationPaneGroups") - - + + ' Forms strTest = CurrentProject.AllForms("frmMain").Name ShowResult "Form exists", (strTest = "frmMain") - - + + ' Reports strTest = CurrentProject.AllReports("rptNavigationPaneGroups").Name ShowResult "Report exists", (strTest = "rptNavigationPaneGroups") ShowResult "Landscape Orientation", (Report_rptNonDefaultPaperSize.Printer.Orientation = acPRORLandscape) ShowResult "A4 Paper Size", (Report_rptNonDefaultPaperSize.Printer.PaperSize = acPRPSA4) - - + + ' Macros strTest = CurrentProject.AllMacros("AutoExec").Name ShowResult "Macro exists", (strTest = "AutoExec") - - + + ' Modules strTest = CurrentProject.AllModules("basUtility").Name ShowResult "Standard Module exists", (strTest = "basUtility") strTest = GetVBProjectForCurrentDB.VBComponents("basExtendedChars").CodeModule.Lines(6, 1) ShowResult "Extended ASCII text in VBA", (Mid$(strTest, 10, 1) = Chr(151)) - + strTest = CurrentProject.AllModules("clsPerson").Name ShowResult "Class Module exists", (strTest = "clsPerson") - - + + ' Database properties strTest = "" strTest = dbs.Properties("AppIcon") @@ -493,51 +485,51 @@ Public Sub cmdRunTests_Click() strTest = dbs.Properties("DAOProperty").Value ShowResult "Custom Database (DAO) property", (strTest = "DAO") - + strTest = CurrentProject.Properties("ProjectProperty").Value ShowResult "Custom Project Property", (strTest = "TestValue") - + strTest = dbs.Containers("Databases").Documents("SummaryInfo").Properties("Title") ShowResult "Database Summary Property (Title)", (strTest = "VCS Testing") - + strTest = dbs.Containers("Tables").Documents("tblSaveXML").Properties("Description") ShowResult "Navigation pane object description", (strTest = "Saved description in XML table.") - + strTest = dbs.Containers("Modules").Documents("basUtility").Properties("Description") ShowResult "Module description", (strTest = "My special description on the code module.") - + ShowResult "Saved shared images", (CurrentProject.Resources.Count > 2) - + ShowResult "Saved import/export specs (XML)", (CurrentProject.ImportExportSpecifications.Count > 0) - + strTest = CurrentProject.ImportExportSpecifications(0).Name ShowResult "Name of saved specification", (strTest = "Export-MSysIMEXColumns") - + strTest = Nz(DLookup("SpecName", "MSysIMEXSpecs", "SpecName=""Test 2""")) ShowResult "Saved IMEX spec (Table based)", (strTest = "Test 2") - + strTest = Nz(DLookup("Name", "MSysNavPaneGroups", "Name=""My Modules""")) ShowResult "Custom navigation pane group", (strTest = "My Modules") - + ' VBE Project With GetVBProjectForCurrentDB - + ShowResult "VBE project name", (.Name = "VCS Testing") ShowResult "VBE project description", (.Description = "For automated testing of Version Control") ShowResult "Help context id", (.HelpContextId = 123456) - + strTest = .References("Scripting").Name ShowResult "GUID reference (scripting)", (strTest = "Scripting") - + strTest = .References("MSForms").Name ShowResult "MS Forms 2.0 reference", (strTest = "MSForms") - + End With - + ' Theme strTest = CurrentDb.Properties("Theme Resource Name") ShowResult "Active theme = Angles", (strTest = "Angles") - + strTest = vbNullString For Each rsc In CurrentProject.Resources If rsc.Type = acResourceTheme Then @@ -546,26 +538,26 @@ Public Sub cmdRunTests_Click() End If Next rsc ShowResult "Theme resource exists", (strTest = "Angles") - + ' Other ShowResult "VCS Options file exists", FSO.FileExists(ExportFolder & "vcs-options.json") - - + + '======================== ' END TESTS '======================== - + ' Display results lblResults.Caption = _ m_Totals(True) & " tests passed" & vbCrLf & _ m_Totals(False) & " tests failed" - + If m_Totals(False) = 0 Then imgResult.Picture = "button_ok" Else imgResult.Picture = "button_error" End If - + If Err Then Err.Clear End Sub diff --git a/Testing/Testing.accdb.src/modules/Module1.bas b/Testing/Testing.accdb.src/modules/Module1.bas index ac5166d4..8bebdef5 100644 --- a/Testing/Testing.accdb.src/modules/Module1.bas +++ b/Testing/Testing.accdb.src/modules/Module1.bas @@ -47,29 +47,29 @@ Public Sub PrtMipCols(ByVal strName As String) Dim rpt As Report Const PM_HORIZONTALCOLS = 1953 Const PM_VERTICALCOLS = 1954 - + ' Open the report. DoCmd.OpenReport strName, acDesign Set rpt = Reports(strName) PrtMipString.strRGB = rpt.PrtMip LSet PM = PrtMipString - + ' Create two columns. PM.cxColumns = 2 - + ' Set 0.25 inch between rows. PM.xRowSpacing = 0.25 * 1440 - + ' Set 0.5 inch between columns. PM.yColumnSpacing = 0.5 * 1440 PM.rItemLayout = PM_HORIZONTALCOLS - + ' Update property. LSet PrtMipString = PM rpt.PrtMip = PrtMipString.strRGB - + Set rpt = Nothing - + End Sub @@ -81,26 +81,26 @@ Public Sub TestPrinterMIP() Dim strData As String Dim lngNull As Long Dim lngStart As Long - + Set rpt = Report_rptDefaultPrinter Set rpt = Report_rptNavigationPaneGroups - + tBuffer.strBuffer = rpt.PrtDevNames LSet tDevNames = tBuffer - + ' Bytes in structure before the data string starts - + 'debug.Print mid$(strdata,tDevNames.wDeviceOffset- lngstart,instr - + strData = StrConv(tDevNames.extra, vbUnicode) - + Debug.Print GetNullTermStringByOffset(strData, 7, tDevNames.wDriverOffset) Debug.Print GetNullTermStringByOffset(strData, 7, tDevNames.wDeviceOffset) Debug.Print GetNullTermStringByOffset(strData, 7, tDevNames.wOutputOffset) - - + + Stop - + End Sub @@ -112,14 +112,14 @@ End Sub '--------------------------------------------------------------------------------------- ' Private Function GetNullTermStringByOffset(strData As String, lngHeaderLen As Long, intOffset As Integer) As String - + Dim lngNull As Long Dim lngStart As Long - + lngStart = intOffset - lngHeaderLen lngNull = InStr(lngStart, strData, vbNullChar) - + ' Return the string if we found a null terminator If lngNull > 0 Then GetNullTermStringByOffset = Mid$(strData, lngStart, lngNull - lngStart) - + End Function diff --git a/Testing/Testing.accdb.src/modules/basUtility.bas b/Testing/Testing.accdb.src/modules/basUtility.bas index ec062104..f58c5123 100644 --- a/Testing/Testing.accdb.src/modules/basUtility.bas +++ b/Testing/Testing.accdb.src/modules/basUtility.bas @@ -36,10 +36,10 @@ Public Sub RunAfterBuild() ' Compile and save VBA code. Should prompt for any errors here. DoCmd.RunCommand acCmdCompileAndSaveAllModules - + ' Run startup macro to execute tests. DoCmd.RunMacro "AutoExec" - + End Sub @@ -61,15 +61,15 @@ Public Sub TestProperties() Dim dbs As DAO.Database Dim prp As AccessObjectProperty Dim proj As CurrentProject - + Set dbs = CurrentDb Set proj = CurrentProject - + For Each prp In proj.AllModules(0).Properties 'For Each prp In dbs.TableDefs("tblLinkedCSV").Properties Debug.Print prp.Name & ": " & prp.Value Next prp - + End Sub @@ -97,7 +97,7 @@ Public Function GetVBProjectForCurrentDB() As VBProject Dim objProj As Object Dim strPath As String - + strPath = CurrentProject.FullName If VBE.ActiveVBProject.FileName = strPath Then ' Use currently active project @@ -111,5 +111,5 @@ Public Function GetVBProjectForCurrentDB() As VBProject End If Next objProj End If - + End Function diff --git a/Testing/Testing.accdb.src/queries/qryNavigationPaneGroups.sql b/Testing/Testing.accdb.src/queries/qryNavigationPaneGroups.sql index 711cdc66..f888537a 100644 --- a/Testing/Testing.accdb.src/queries/qryNavigationPaneGroups.sql +++ b/Testing/Testing.accdb.src/queries/qryNavigationPaneGroups.sql @@ -1,4 +1,30 @@ -SELECT MSysNavPaneGroups.Name AS GroupName, MSysNavPaneGroups.Flags AS GroupFlags, MSysNavPaneGroups.Position AS GroupPosition, MSysObjects.Type AS ObjectType, MSysObjects.Name AS ObjectName, MSysNavPaneGroupToObjects.Flags AS ObjectFlags, MSysNavPaneGroupToObjects.Icon AS ObjectIcon, MSysNavPaneGroupToObjects.Position AS ObjectPosition -FROM MSysNavPaneGroups LEFT JOIN (MSysNavPaneGroupToObjects LEFT JOIN MSysObjects ON MSysNavPaneGroupToObjects.ObjectID = MSysObjects.Id) ON MSysNavPaneGroups.Id = MSysNavPaneGroupToObjects.GroupID -WHERE (((MSysNavPaneGroups.Name) Is Not Null) AND ((MSysNavPaneGroups.GroupCategoryID)=3)) -ORDER BY MSysNavPaneGroups.Name, MSysObjects.Type, MSysObjects.Name; +SELECT + MSysNavPaneGroups.Name AS GroupName, + MSysNavPaneGroups.Flags AS GroupFlags, + MSysNavPaneGroups.Position AS GroupPosition, + MSysObjects.Type AS ObjectType, + MSysObjects.Name AS ObjectName, + MSysNavPaneGroupToObjects.Flags AS ObjectFlags, + MSysNavPaneGroupToObjects.Icon AS ObjectIcon, + MSysNavPaneGroupToObjects.Position AS ObjectPosition +FROM + MSysNavPaneGroups + LEFT JOIN ( + MSysNavPaneGroupToObjects + LEFT JOIN MSysObjects ON MSysNavPaneGroupToObjects.ObjectID = MSysObjects.Id + ) ON MSysNavPaneGroups.Id = MSysNavPaneGroupToObjects.GroupID +WHERE + ( + ( + (MSysNavPaneGroups.Name) Is Not Null + ) + AND ( + ( + MSysNavPaneGroups.GroupCategoryID + )= 3 + ) + ) +ORDER BY + MSysNavPaneGroups.Name, + MSysObjects.Type, + MSysObjects.Name; diff --git a/Testing/Testing.accdb.src/vbeforms/frmForm20.frx b/Testing/Testing.accdb.src/vbeforms/frmForm20.frx index d1e642c5..dacd8c8e 100644 Binary files a/Testing/Testing.accdb.src/vbeforms/frmForm20.frx and b/Testing/Testing.accdb.src/vbeforms/frmForm20.frx differ diff --git a/Testing/Testing.accdb.src/vbeforms/frmForm20.json b/Testing/Testing.accdb.src/vbeforms/frmForm20.json index 6cc7a116..22c8a8a3 100644 --- a/Testing/Testing.accdb.src/vbeforms/frmForm20.json +++ b/Testing/Testing.accdb.src/vbeforms/frmForm20.json @@ -819,13 +819,13 @@ "ControlTipText": "", "Height": 24, "HelpContextID": 0, - "Left": 30, + "Left": 24, "TabIndex": 12, "TabStop": true, "Tag": "", "Top": 222, "Visible": true, - "Width": 84, + "Width": 96, "BackColor": -2147483633, "Delay": 50, "Enabled": true, diff --git a/Testing/Testing.accdb.src/vcs-options.json b/Testing/Testing.accdb.src/vcs-options.json index 9a5fd1dc..6f864346 100644 --- a/Testing/Testing.accdb.src/vcs-options.json +++ b/Testing/Testing.accdb.src/vcs-options.json @@ -1,6 +1,6 @@ { "Info": { - "AddinVersion": "4.0.13", + "AddinVersion": "4.0.22", "AccessVersion": "14.0 32-bit" }, "Options": { @@ -33,6 +33,7 @@ "TTOption": false }, "SaveQuerySQL": true, + "FormatSQL": true, "ForceImportOriginalQuerySQL": false, "SaveTableSQL": true, "StripPublishOption": true, @@ -56,6 +57,8 @@ "Format": "Tab Delimited" } }, + "SchemaExports": { + }, "RunBeforeExport": "", "RunAfterExport": "", "RunBeforeBuild": "",