Skip to content

Commit 6071bb9

Browse files
josef-poetzljosef-poetzl
authored
Dev call proc by application run (#17)
* refactoring: reduced dependency * use Application.Run to call procedures (calling add-in procedures is possible)
1 parent 3861f3c commit 6071bb9

6 files changed

Lines changed: 148 additions & 55 deletions

File tree

‎source/dbs-properties.json‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -101,7 +101,7 @@
101101
"Type": 4
102102
},
103103
"NavPane Width": {
104-
"Value": 215,
104+
"Value": 591,
105105
"Type": 4
106106
},
107107
"Never Cache": {

‎source/forms/InstallAddInForm.bas‎

Lines changed: 36 additions & 36 deletions
Original file line numberDiff line numberDiff line change
@@ -153,7 +153,7 @@ Begin Form
153153
TextAlign =1
154154
IMESentenceMode =3
155155
Left =2070
156-
Top =3135
156+
Top =3143
157157
Width =4740
158158
Height =300
159159
TabIndex =5
@@ -165,9 +165,9 @@ Begin Form
165165
ShowDatePicker =0
166166

167167
LayoutCachedLeft =2070
168-
LayoutCachedTop =3135
168+
LayoutCachedTop =3143
169169
LayoutCachedWidth =6810
170-
LayoutCachedHeight =3435
170+
LayoutCachedHeight =3443
171171
RowStart =6
172172
RowEnd =6
173173
ColumnStart =1
@@ -180,7 +180,7 @@ Begin Form
180180
OverlapFlags =85
181181
TextAlign =1
182182
Left =570
183-
Top =3135
183+
Top =3143
184184
Width =1440
185185
Height =300
186186
Name ="lbltxtAddInName"
@@ -191,9 +191,9 @@ Begin Form
191191
BottomPadding =150
192192
HorizontalAnchor =2
193193
LayoutCachedLeft =570
194-
LayoutCachedTop =3135
194+
LayoutCachedTop =3143
195195
LayoutCachedWidth =2010
196-
LayoutCachedHeight =3435
196+
LayoutCachedHeight =3443
197197
RowStart =6
198198
RowEnd =6
199199
LayoutGroup =1
@@ -262,7 +262,7 @@ Begin Form
262262
TextAlign =1
263263
IMESentenceMode =3
264264
Left =2070
265-
Top =3615
265+
Top =3623
266266
Width =4740
267267
Height =300
268268
TabIndex =6
@@ -274,9 +274,9 @@ Begin Form
274274
ShowDatePicker =0
275275

276276
LayoutCachedLeft =2070
277-
LayoutCachedTop =3615
277+
LayoutCachedTop =3623
278278
LayoutCachedWidth =6810
279-
LayoutCachedHeight =3915
279+
LayoutCachedHeight =3923
280280
RowStart =7
281281
RowEnd =7
282282
ColumnStart =1
@@ -289,7 +289,7 @@ Begin Form
289289
OverlapFlags =85
290290
TextAlign =1
291291
Left =570
292-
Top =3615
292+
Top =3623
293293
Width =1440
294294
Height =300
295295
Name ="lblAddInAuthor"
@@ -300,9 +300,9 @@ Begin Form
300300
BottomPadding =150
301301
HorizontalAnchor =2
302302
LayoutCachedLeft =570
303-
LayoutCachedTop =3615
303+
LayoutCachedTop =3623
304304
LayoutCachedWidth =2010
305-
LayoutCachedHeight =3915
305+
LayoutCachedHeight =3923
306306
RowStart =7
307307
RowEnd =7
308308
LayoutGroup =1
@@ -318,7 +318,7 @@ Begin Form
318318
TextAlign =1
319319
IMESentenceMode =3
320320
Left =2070
321-
Top =4095
321+
Top =4103
322322
Width =4740
323323
Height =300
324324
TabIndex =7
@@ -330,9 +330,9 @@ Begin Form
330330
ShowDatePicker =0
331331

332332
LayoutCachedLeft =2070
333-
LayoutCachedTop =4095
333+
LayoutCachedTop =4103
334334
LayoutCachedWidth =6810
335-
LayoutCachedHeight =4395
335+
LayoutCachedHeight =4403
336336
RowStart =8
337337
RowEnd =8
338338
ColumnStart =1
@@ -345,7 +345,7 @@ Begin Form
345345
OverlapFlags =85
346346
TextAlign =1
347347
Left =570
348-
Top =4095
348+
Top =4103
349349
Width =1440
350350
Height =300
351351
Name ="lblAddInCompany"
@@ -356,9 +356,9 @@ Begin Form
356356
BottomPadding =150
357357
HorizontalAnchor =2
358358
LayoutCachedLeft =570
359-
LayoutCachedTop =4095
359+
LayoutCachedTop =4103
360360
LayoutCachedWidth =2010
361-
LayoutCachedHeight =4395
361+
LayoutCachedHeight =4403
362362
RowStart =8
363363
RowEnd =8
364364
LayoutGroup =1
@@ -374,7 +374,7 @@ Begin Form
374374
TextAlign =1
375375
IMESentenceMode =3
376376
Left =2070
377-
Top =4575
377+
Top =4583
378378
Width =4740
379379
Height =1125
380380
TabIndex =8
@@ -387,9 +387,9 @@ Begin Form
387387
ShowDatePicker =0
388388

389389
LayoutCachedLeft =2070
390-
LayoutCachedTop =4575
390+
LayoutCachedTop =4583
391391
LayoutCachedWidth =6810
392-
LayoutCachedHeight =5700
392+
LayoutCachedHeight =5708
393393
RowStart =9
394394
RowEnd =9
395395
ColumnStart =1
@@ -402,7 +402,7 @@ Begin Form
402402
OverlapFlags =85
403403
TextAlign =1
404404
Left =570
405-
Top =4575
405+
Top =4583
406406
Width =1440
407407
Height =1125
408408
Name ="lblAddInComment"
@@ -414,9 +414,9 @@ Begin Form
414414
HorizontalAnchor =2
415415
VerticalAnchor =2
416416
LayoutCachedLeft =570
417-
LayoutCachedTop =4575
417+
LayoutCachedTop =4583
418418
LayoutCachedWidth =2010
419-
LayoutCachedHeight =5700
419+
LayoutCachedHeight =5708
420420
RowStart =9
421421
RowEnd =9
422422
LayoutGroup =1
@@ -428,7 +428,7 @@ Begin Form
428428
Begin CommandButton
429429
OverlapFlags =85
430430
Left =570
431-
Top =6240
431+
Top =6255
432432
Width =6240
433433
Height =450
434434
TabIndex =10
@@ -442,9 +442,9 @@ Begin Form
442442
HorizontalAnchor =2
443443

444444
LayoutCachedLeft =570
445-
LayoutCachedTop =6240
445+
LayoutCachedTop =6255
446446
LayoutCachedWidth =6810
447-
LayoutCachedHeight =6690
447+
LayoutCachedHeight =6705
448448
RowStart =11
449449
RowEnd =11
450450
ColumnEnd =2
@@ -596,7 +596,7 @@ Begin Form
596596
OverlapFlags =85
597597
TextAlign =1
598598
Left =570
599-
Top =2805
599+
Top =2813
600600
Width =6240
601601
Height =300
602602
FontWeight =700
@@ -609,9 +609,9 @@ Begin Form
609609
BottomPadding =0
610610
HorizontalAnchor =2
611611
LayoutCachedLeft =570
612-
LayoutCachedTop =2805
612+
LayoutCachedTop =2813
613613
LayoutCachedWidth =6810
614-
LayoutCachedHeight =3105
614+
LayoutCachedHeight =3113
615615
RowStart =5
616616
RowEnd =5
617617
ColumnEnd =2
@@ -687,7 +687,7 @@ Begin Form
687687
Begin CheckBox
688688
OverlapFlags =85
689689
Left =3015
690-
Top =5880
690+
Top =5888
691691
Width =3795
692692
Height =300
693693
TabIndex =9
@@ -697,9 +697,9 @@ Begin Form
697697
RightPadding =567
698698

699699
LayoutCachedLeft =3015
700-
LayoutCachedTop =5880
700+
LayoutCachedTop =5888
701701
LayoutCachedWidth =6810
702-
LayoutCachedHeight =6180
702+
LayoutCachedHeight =6188
703703
RowStart =10
704704
RowEnd =10
705705
ColumnStart =2
@@ -711,7 +711,7 @@ Begin Form
711711
OverlapFlags =85
712712
TextAlign =1
713713
Left =570
714-
Top =5880
714+
Top =5888
715715
Width =2415
716716
Height =300
717717
ForeColor =0
@@ -722,9 +722,9 @@ Begin Form
722722
RightPadding =0
723723
HorizontalAnchor =2
724724
LayoutCachedLeft =570
725-
LayoutCachedTop =5880
725+
LayoutCachedTop =5888
726726
LayoutCachedWidth =2985
727-
LayoutCachedHeight =6180
727+
LayoutCachedHeight =6188
728728
RowStart =10
729729
RowEnd =10
730730
ColumnEnd =1

‎source/modules/ACLibFileManager.cls‎

Lines changed: 99 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -417,12 +417,12 @@ Private Sub ImportFilesFromImportCollection( _
417417
If (0 / 1) + (Not Not m_CLI.ExecuteList) Then
418418
AccessProgressBar.Init "Run executes ...", UBound(m_CLI.ExecuteList) + 1, 1
419419
For i = 0 To UBound(m_CLI.ExecuteList)
420-
AccessProgressBar.PerformStep
421-
If StringTools.Contains(m_CLI.ExecuteList(i), REPOSTITORY_ROOT_CODE_PRIVATEROOT) Then
422-
Eval VBA.Strings.Replace(m_CLI.ExecuteList(i), REPOSTITORY_ROOT_CODE_PRIVATEROOT, LocalRepositoryRootDirectory())
423-
Else
424-
Eval (m_CLI.ExecuteList(i))
425-
End If
420+
AccessProgressBar.PerformStep
421+
If StringTools.Contains(m_CLI.ExecuteList(i), REPOSTITORY_ROOT_CODE_PRIVATEROOT) Then
422+
ApplicationRunProcedure VBA.Strings.Replace(m_CLI.ExecuteList(i), REPOSTITORY_ROOT_CODE_PRIVATEROOT, LocalRepositoryRootDirectory())
423+
Else
424+
ApplicationRunProcedure m_CLI.ExecuteList(i)
425+
End If
426426
Next
427427
If AccessProgressBar.IsInitialized Then AccessProgressBar.Clear
428428
End If
@@ -438,6 +438,99 @@ Private Sub ImportFilesFromImportCollection( _
438438

439439
End Sub
440440

441+
Private Sub ApplicationRunProcedure(ByVal ProcedureCall As String)
442+
443+
If InStr(1, ProcedureCall, ".") Then
444+
If TryRunAddInProcedure(ProcedureCall) Then
445+
Exit Sub
446+
End If
447+
End If
448+
449+
CallApplicationRun ProcedureCall
450+
451+
End Sub
452+
453+
Private Function TryRunAddInProcedure(ByVal ProcedureCall As String) As Boolean
454+
455+
Dim AddInFilePath As String
456+
457+
ProcedureCall = Replace(ProcedureCall, "%addins%", Environ$("appdata") & "\Microsoft\AddIns", , , vbTextCompare)
458+
ProcedureCall = Replace(ProcedureCall, "%appdata%", Environ("appdata"), , , vbTextCompare)
459+
460+
AddInFilePath = Left(ProcedureCall, InStrRev(ProcedureCall, ".")) & "accda"
461+
If Len(VBA.Dir(AddInFilePath)) = 0 Then
462+
If Mid(ProcedureCall, 2, 1) = ":" Then ' is an add-in call, but add-in is not available => ignore it
463+
VBA.MsgBox "Add-in '" & AddInFilePath & "' is not available, procedure call is skipped", vbInformation, "Call procedure skipped"
464+
TryRunAddInProcedure = True
465+
End If
466+
Exit Function
467+
End If
468+
469+
TryRunAddInProcedure = True
470+
CallApplicationRun ProcedureCall
471+
472+
End Function
473+
474+
Private Function CallApplicationRun(ByVal ProcedureCall As String)
475+
476+
Dim ProcName As String
477+
Dim ProcParams() As String
478+
Dim ParamCount As Long
479+
480+
ParamCount = GetProcNameAndParams(ProcedureCall, ProcName, ProcParams)
481+
482+
Select Case ParamCount
483+
Case 0
484+
Application.Run ProcName
485+
Case 1
486+
Application.Run ProcName, ProcParams(0)
487+
Case 2
488+
Application.Run ProcName, ProcParams(0), ProcParams(1)
489+
Case 3
490+
Application.Run ProcName, ProcParams(0), ProcParams(1), ProcParams(2)
491+
Case 4
492+
Application.Run ProcName, ProcParams(0), ProcParams(1), ProcParams(2), ProcParams(3)
493+
Case Else
494+
Err.Raise vbObjectError, "ACLibFileManager.CallApplicationRun", "Only 4 parameters implemented"
495+
End Select
496+
497+
End Function
498+
499+
Private Function GetProcNameAndParams(ByVal ProcedureCall As String, ByRef ProcName As String, ByRef ProcParams() As String) As Long
500+
501+
Dim ProcParamString As String
502+
Dim ParamPos As Long
503+
504+
ProcedureCall = Replace(ProcedureCall, "()", vbNullString)
505+
506+
ParamPos = InStr(1, ProcedureCall, "(")
507+
508+
If ParamPos = 0 Then
509+
ProcName = ProcedureCall
510+
GetProcNameAndParams = 0
511+
Exit Function
512+
End If
513+
514+
ProcName = Left(ProcedureCall, ParamPos - 1)
515+
ProcParamString = Trim(Mid(ProcedureCall, ParamPos + 1))
516+
517+
If Right(ProcParamString, 1) = ")" Then
518+
ProcParamString = Left(ProcParamString, Len(ProcParamString) - 1)
519+
End If
520+
521+
ProcParams = Split(ProcParamString, ",")
522+
523+
Dim i As Long
524+
For i = LBound(ProcParams) To UBound(ProcParams)
525+
ProcParams(i) = Trim(ProcParams(i))
526+
If Left(ProcParams(i), 1) = """" Then
527+
ProcParams(i) = Mid(ProcParams(i), 2, Len(ProcParams(i)) - 2)
528+
End If
529+
Next
530+
531+
GetProcNameAndParams = UBound(ProcParams) + 1
532+
533+
End Function
441534

442535
Private Function IgnoreFolder(ByRef TestFolder As Object) As Boolean
443536
'/*

0 commit comments

Comments
 (0)