Skip to content

Dev call proc by application run #17

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Merged
merged 4 commits into from
Jun 18, 2025
Merged

Dev call proc by application run #17

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
4 commits
Select commit Hold shift + click to select a range
81f02fa
refactoring: reduced dependency
josef-poetzl Jun 18, 2025
087c104
SCC updates: letter case, layout
josef-poetzl Jun 18, 2025
3d5a13a
use Application.Run to call procedures (calling add-in procedures is …
josef-poetzl Jun 18, 2025
02cc11a
Skip add-in procedure call if add-in is missing
josef-poetzl Jun 18, 2025
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
2 changes: 1 addition & 1 deletion source/dbs-properties.json
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -101,7 +101,7 @@
"Type": 4
},
"NavPane Width": {
"Value": 215,
"Value": 591,
"Type": 4
},
"Never Cache": {
Expand Down
72 changes: 36 additions & 36 deletions source/forms/InstallAddInForm.bas
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -153,7 +153,7 @@ Begin Form
TextAlign =1
IMESentenceMode =3
Left =2070
Top =3135
Top =3143
Width =4740
Height =300
TabIndex =5
Expand All @@ -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
Expand All @@ -180,7 +180,7 @@ Begin Form
OverlapFlags =85
TextAlign =1
Left =570
Top =3135
Top =3143
Width =1440
Height =300
Name ="lbltxtAddInName"
Expand All @@ -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
Expand Down Expand Up @@ -262,7 +262,7 @@ Begin Form
TextAlign =1
IMESentenceMode =3
Left =2070
Top =3615
Top =3623
Width =4740
Height =300
TabIndex =6
Expand All @@ -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
Expand All @@ -289,7 +289,7 @@ Begin Form
OverlapFlags =85
TextAlign =1
Left =570
Top =3615
Top =3623
Width =1440
Height =300
Name ="lblAddInAuthor"
Expand All @@ -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
Expand All @@ -318,7 +318,7 @@ Begin Form
TextAlign =1
IMESentenceMode =3
Left =2070
Top =4095
Top =4103
Width =4740
Height =300
TabIndex =7
Expand All @@ -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
Expand All @@ -345,7 +345,7 @@ Begin Form
OverlapFlags =85
TextAlign =1
Left =570
Top =4095
Top =4103
Width =1440
Height =300
Name ="lblAddInCompany"
Expand All @@ -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
Expand All @@ -374,7 +374,7 @@ Begin Form
TextAlign =1
IMESentenceMode =3
Left =2070
Top =4575
Top =4583
Width =4740
Height =1125
TabIndex =8
Expand All @@ -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
Expand All @@ -402,7 +402,7 @@ Begin Form
OverlapFlags =85
TextAlign =1
Left =570
Top =4575
Top =4583
Width =1440
Height =1125
Name ="lblAddInComment"
Expand All @@ -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
Expand All @@ -428,7 +428,7 @@ Begin Form
Begin CommandButton
OverlapFlags =85
Left =570
Top =6240
Top =6255
Width =6240
Height =450
TabIndex =10
Expand All @@ -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
Expand Down Expand Up @@ -596,7 +596,7 @@ Begin Form
OverlapFlags =85
TextAlign =1
Left =570
Top =2805
Top =2813
Width =6240
Height =300
FontWeight =700
Expand All @@ -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
Expand Down Expand Up @@ -687,7 +687,7 @@ Begin Form
Begin CheckBox
OverlapFlags =85
Left =3015
Top =5880
Top =5888
Width =3795
Height =300
TabIndex =9
Expand All @@ -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
Expand All @@ -711,7 +711,7 @@ Begin Form
OverlapFlags =85
TextAlign =1
Left =570
Top =5880
Top =5888
Width =2415
Height =300
ForeColor =0
Expand All @@ -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
Expand Down
105 changes: 99 additions & 6 deletions source/modules/ACLibFileManager.cls
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand All @@ -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
'/*
Expand Down
Loading