diff --git a/source/dbs-properties.json b/source/dbs-properties.json index 8239841..1c2eb72 100644 --- a/source/dbs-properties.json +++ b/source/dbs-properties.json @@ -101,7 +101,7 @@ "Type": 4 }, "NavPane Width": { - "Value": 215, + "Value": 591, "Type": 4 }, "Never Cache": { diff --git a/source/forms/InstallAddInForm.bas b/source/forms/InstallAddInForm.bas index 9a2a181..ac2adab 100644 --- a/source/forms/InstallAddInForm.bas +++ b/source/forms/InstallAddInForm.bas @@ -153,7 +153,7 @@ Begin Form TextAlign =1 IMESentenceMode =3 Left =2070 - Top =3135 + Top =3143 Width =4740 Height =300 TabIndex =5 @@ -165,9 +165,9 @@ Begin Form ShowDatePicker =0 LayoutCachedLeft =2070 - LayoutCachedTop =3135 + LayoutCachedTop =3143 LayoutCachedWidth =6810 - LayoutCachedHeight =3435 + LayoutCachedHeight =3443 RowStart =6 RowEnd =6 ColumnStart =1 @@ -180,7 +180,7 @@ Begin Form OverlapFlags =85 TextAlign =1 Left =570 - Top =3135 + Top =3143 Width =1440 Height =300 Name ="lbltxtAddInName" @@ -191,9 +191,9 @@ Begin Form BottomPadding =150 HorizontalAnchor =2 LayoutCachedLeft =570 - LayoutCachedTop =3135 + LayoutCachedTop =3143 LayoutCachedWidth =2010 - LayoutCachedHeight =3435 + LayoutCachedHeight =3443 RowStart =6 RowEnd =6 LayoutGroup =1 @@ -262,7 +262,7 @@ Begin Form TextAlign =1 IMESentenceMode =3 Left =2070 - Top =3615 + Top =3623 Width =4740 Height =300 TabIndex =6 @@ -274,9 +274,9 @@ Begin Form ShowDatePicker =0 LayoutCachedLeft =2070 - LayoutCachedTop =3615 + LayoutCachedTop =3623 LayoutCachedWidth =6810 - LayoutCachedHeight =3915 + LayoutCachedHeight =3923 RowStart =7 RowEnd =7 ColumnStart =1 @@ -289,7 +289,7 @@ Begin Form OverlapFlags =85 TextAlign =1 Left =570 - Top =3615 + Top =3623 Width =1440 Height =300 Name ="lblAddInAuthor" @@ -300,9 +300,9 @@ Begin Form BottomPadding =150 HorizontalAnchor =2 LayoutCachedLeft =570 - LayoutCachedTop =3615 + LayoutCachedTop =3623 LayoutCachedWidth =2010 - LayoutCachedHeight =3915 + LayoutCachedHeight =3923 RowStart =7 RowEnd =7 LayoutGroup =1 @@ -318,7 +318,7 @@ Begin Form TextAlign =1 IMESentenceMode =3 Left =2070 - Top =4095 + Top =4103 Width =4740 Height =300 TabIndex =7 @@ -330,9 +330,9 @@ Begin Form ShowDatePicker =0 LayoutCachedLeft =2070 - LayoutCachedTop =4095 + LayoutCachedTop =4103 LayoutCachedWidth =6810 - LayoutCachedHeight =4395 + LayoutCachedHeight =4403 RowStart =8 RowEnd =8 ColumnStart =1 @@ -345,7 +345,7 @@ Begin Form OverlapFlags =85 TextAlign =1 Left =570 - Top =4095 + Top =4103 Width =1440 Height =300 Name ="lblAddInCompany" @@ -356,9 +356,9 @@ Begin Form BottomPadding =150 HorizontalAnchor =2 LayoutCachedLeft =570 - LayoutCachedTop =4095 + LayoutCachedTop =4103 LayoutCachedWidth =2010 - LayoutCachedHeight =4395 + LayoutCachedHeight =4403 RowStart =8 RowEnd =8 LayoutGroup =1 @@ -374,7 +374,7 @@ Begin Form TextAlign =1 IMESentenceMode =3 Left =2070 - Top =4575 + Top =4583 Width =4740 Height =1125 TabIndex =8 @@ -387,9 +387,9 @@ Begin Form ShowDatePicker =0 LayoutCachedLeft =2070 - LayoutCachedTop =4575 + LayoutCachedTop =4583 LayoutCachedWidth =6810 - LayoutCachedHeight =5700 + LayoutCachedHeight =5708 RowStart =9 RowEnd =9 ColumnStart =1 @@ -402,7 +402,7 @@ Begin Form OverlapFlags =85 TextAlign =1 Left =570 - Top =4575 + Top =4583 Width =1440 Height =1125 Name ="lblAddInComment" @@ -414,9 +414,9 @@ Begin Form HorizontalAnchor =2 VerticalAnchor =2 LayoutCachedLeft =570 - LayoutCachedTop =4575 + LayoutCachedTop =4583 LayoutCachedWidth =2010 - LayoutCachedHeight =5700 + LayoutCachedHeight =5708 RowStart =9 RowEnd =9 LayoutGroup =1 @@ -428,7 +428,7 @@ Begin Form Begin CommandButton OverlapFlags =85 Left =570 - Top =6240 + Top =6255 Width =6240 Height =450 TabIndex =10 @@ -442,9 +442,9 @@ Begin Form HorizontalAnchor =2 LayoutCachedLeft =570 - LayoutCachedTop =6240 + LayoutCachedTop =6255 LayoutCachedWidth =6810 - LayoutCachedHeight =6690 + LayoutCachedHeight =6705 RowStart =11 RowEnd =11 ColumnEnd =2 @@ -596,7 +596,7 @@ Begin Form OverlapFlags =85 TextAlign =1 Left =570 - Top =2805 + Top =2813 Width =6240 Height =300 FontWeight =700 @@ -609,9 +609,9 @@ Begin Form BottomPadding =0 HorizontalAnchor =2 LayoutCachedLeft =570 - LayoutCachedTop =2805 + LayoutCachedTop =2813 LayoutCachedWidth =6810 - LayoutCachedHeight =3105 + LayoutCachedHeight =3113 RowStart =5 RowEnd =5 ColumnEnd =2 @@ -687,7 +687,7 @@ Begin Form Begin CheckBox OverlapFlags =85 Left =3015 - Top =5880 + Top =5888 Width =3795 Height =300 TabIndex =9 @@ -697,9 +697,9 @@ Begin Form RightPadding =567 LayoutCachedLeft =3015 - LayoutCachedTop =5880 + LayoutCachedTop =5888 LayoutCachedWidth =6810 - LayoutCachedHeight =6180 + LayoutCachedHeight =6188 RowStart =10 RowEnd =10 ColumnStart =2 @@ -711,7 +711,7 @@ Begin Form OverlapFlags =85 TextAlign =1 Left =570 - Top =5880 + Top =5888 Width =2415 Height =300 ForeColor =0 @@ -722,9 +722,9 @@ Begin Form RightPadding =0 HorizontalAnchor =2 LayoutCachedLeft =570 - LayoutCachedTop =5880 + LayoutCachedTop =5888 LayoutCachedWidth =2985 - LayoutCachedHeight =6180 + LayoutCachedHeight =6188 RowStart =10 RowEnd =10 ColumnEnd =1 diff --git a/source/modules/ACLibFileManager.cls b/source/modules/ACLibFileManager.cls index 7f210ad..d072d63 100644 --- a/source/modules/ACLibFileManager.cls +++ b/source/modules/ACLibFileManager.cls @@ -417,12 +417,12 @@ Private Sub ImportFilesFromImportCollection( _ If (0 / 1) + (Not Not m_CLI.ExecuteList) Then AccessProgressBar.Init "Run executes ...", UBound(m_CLI.ExecuteList) + 1, 1 For i = 0 To UBound(m_CLI.ExecuteList) - AccessProgressBar.PerformStep - If StringTools.Contains(m_CLI.ExecuteList(i), REPOSTITORY_ROOT_CODE_PRIVATEROOT) Then - Eval VBA.Strings.Replace(m_CLI.ExecuteList(i), REPOSTITORY_ROOT_CODE_PRIVATEROOT, LocalRepositoryRootDirectory()) - Else - Eval (m_CLI.ExecuteList(i)) - End If + AccessProgressBar.PerformStep + If StringTools.Contains(m_CLI.ExecuteList(i), REPOSTITORY_ROOT_CODE_PRIVATEROOT) Then + ApplicationRunProcedure VBA.Strings.Replace(m_CLI.ExecuteList(i), REPOSTITORY_ROOT_CODE_PRIVATEROOT, LocalRepositoryRootDirectory()) + Else + ApplicationRunProcedure m_CLI.ExecuteList(i) + End If Next If AccessProgressBar.IsInitialized Then AccessProgressBar.Clear End If @@ -438,6 +438,99 @@ Private Sub ImportFilesFromImportCollection( _ End Sub +Private Sub ApplicationRunProcedure(ByVal ProcedureCall As String) + + If InStr(1, ProcedureCall, ".") Then + If TryRunAddInProcedure(ProcedureCall) Then + Exit Sub + End If + End If + + CallApplicationRun ProcedureCall + +End Sub + +Private Function TryRunAddInProcedure(ByVal ProcedureCall As String) As Boolean + + Dim AddInFilePath As String + + ProcedureCall = Replace(ProcedureCall, "%addins%", Environ$("appdata") & "\Microsoft\AddIns", , , vbTextCompare) + ProcedureCall = Replace(ProcedureCall, "%appdata%", Environ("appdata"), , , vbTextCompare) + + AddInFilePath = Left(ProcedureCall, InStrRev(ProcedureCall, ".")) & "accda" + If Len(VBA.Dir(AddInFilePath)) = 0 Then + If Mid(ProcedureCall, 2, 1) = ":" Then ' is an add-in call, but add-in is not available => ignore it + VBA.MsgBox "Add-in '" & AddInFilePath & "' is not available, procedure call is skipped", vbInformation, "Call procedure skipped" + TryRunAddInProcedure = True + End If + Exit Function + End If + + TryRunAddInProcedure = True + CallApplicationRun ProcedureCall + +End Function + +Private Function CallApplicationRun(ByVal ProcedureCall As String) + + Dim ProcName As String + Dim ProcParams() As String + Dim ParamCount As Long + + ParamCount = GetProcNameAndParams(ProcedureCall, ProcName, ProcParams) + + Select Case ParamCount + Case 0 + Application.Run ProcName + Case 1 + Application.Run ProcName, ProcParams(0) + Case 2 + Application.Run ProcName, ProcParams(0), ProcParams(1) + Case 3 + Application.Run ProcName, ProcParams(0), ProcParams(1), ProcParams(2) + Case 4 + Application.Run ProcName, ProcParams(0), ProcParams(1), ProcParams(2), ProcParams(3) + Case Else + Err.Raise vbObjectError, "ACLibFileManager.CallApplicationRun", "Only 4 parameters implemented" + End Select + +End Function + +Private Function GetProcNameAndParams(ByVal ProcedureCall As String, ByRef ProcName As String, ByRef ProcParams() As String) As Long + + Dim ProcParamString As String + Dim ParamPos As Long + + ProcedureCall = Replace(ProcedureCall, "()", vbNullString) + + ParamPos = InStr(1, ProcedureCall, "(") + + If ParamPos = 0 Then + ProcName = ProcedureCall + GetProcNameAndParams = 0 + Exit Function + End If + + ProcName = Left(ProcedureCall, ParamPos - 1) + ProcParamString = Trim(Mid(ProcedureCall, ParamPos + 1)) + + If Right(ProcParamString, 1) = ")" Then + ProcParamString = Left(ProcParamString, Len(ProcParamString) - 1) + End If + + ProcParams = Split(ProcParamString, ",") + + Dim i As Long + For i = LBound(ProcParams) To UBound(ProcParams) + ProcParams(i) = Trim(ProcParams(i)) + If Left(ProcParams(i), 1) = """" Then + ProcParams(i) = Mid(ProcParams(i), 2, Len(ProcParams(i)) - 2) + End If + Next + + GetProcNameAndParams = UBound(ProcParams) + 1 + +End Function Private Function IgnoreFolder(ByRef TestFolder As Object) As Boolean '/* diff --git a/source/modules/AddInConfiguration.cls b/source/modules/AddInConfiguration.cls index d788782..79b659d 100644 --- a/source/modules/AddInConfiguration.cls +++ b/source/modules/AddInConfiguration.cls @@ -22,7 +22,6 @@ Attribute VB_Exposed = False ' ' _codelib/addins/shared/AddInConfiguration.cls ' _codelib/license.bas -' base/ApplicationHandler.cls ' DAO50{00025E01-0000-0000-C000-000000000046} ' '--------------------------------------------------------------------------------------- @@ -260,7 +259,7 @@ HandleErr: Resume ExitHere End If - HandleError Err.Number, Err.Source, Err.Description, aclibErrRaise + Err.Raise Err.Number, "AddInConfiguration.SetDbProperty->" & Err.Source, Err.Description End Sub @@ -281,7 +280,7 @@ HandleErr: Resume ExitHere End If - HandleError Err.Number, Err.Source, Err.Description, aclibErrRaise + Err.Raise Err.Number, "AddInConfiguration.SetDocProperty->" & Err.Source, Err.Description End Sub diff --git a/source/modules/AddInInstaller.cls b/source/modules/AddInInstaller.cls index 72ce114..872cba6 100644 --- a/source/modules/AddInInstaller.cls +++ b/source/modules/AddInInstaller.cls @@ -23,7 +23,6 @@ Attribute VB_Exposed = False ' _codelib/addins/shared/AddInInstaller.cls ' _codelib/license.bas ' _codelib/addins/shared/AddInConfiguration.cls -' file/FileTools.bas ' DAO50{00025E01-0000-0000-C000-000000000046} ' '--------------------------------------------------------------------------------------- @@ -104,9 +103,11 @@ Private Function DeleteAddInFiles() End Function Private Function DeleteFile(File2Delete) - If FileTools.FileExists(File2Delete) Then - Kill File2Delete - End If + With CreateObject("Scripting.FileSystemObject") + If .FileExists(File2Delete) Then + .DeleteFile File2Delete, True + End If + End With End Function Private Function TryFileCopy(ByVal SourceFilePath As String, ByVal DestFilePath As String) As Boolean diff --git a/source/modules/ApplicationHandler.cls b/source/modules/ApplicationHandler.cls index 315dad1..4a1ee69 100644 --- a/source/modules/ApplicationHandler.cls +++ b/source/modules/ApplicationHandler.cls @@ -112,7 +112,7 @@ Private m_AppDb As DAO.Database ' Replacement for CurrentDb or Code Private m_ApplicationName As String ' Application name cache (short) Private m_ApplicationFullName As String ' Application name cache (long) -Private m_APPLICATIONVERSION As String ' Version number to be displayed +Private m_ApplicationVersion As String ' Version number to be displayed Private m_TransferValue As Variant Private m_PublicPath As String ' Default directory for file explorer @@ -351,19 +351,19 @@ End Property '--------------------------------------------------------------------------------------- Public Property Get Version() As String - If Len(m_APPLICATIONVERSION) = 0 Then ' ... aus Properties lesen? + If Len(m_ApplicationVersion) = 0 Then ' ... aus Properties lesen? '/** ' @todo Versionskennung aus DB-Eigenschaften bzw. aus den Dateieigenschaften lesen '**/ - m_APPLICATIONVERSION = "" + m_ApplicationVersion = "" End If - Version = m_APPLICATIONVERSION + Version = m_ApplicationVersion End Property Public Property Let Version(ByVal AppVersion As String) - m_APPLICATIONVERSION = AppVersion + m_ApplicationVersion = AppVersion End Property '---------------------------------------------------------------------------------------