Skip to content

Commit 1751ec3

Browse files
committed
TypeLibCheck similar to Excel code
1 parent a4289df commit 1751ec3

File tree

6 files changed

+62
-59
lines changed

6 files changed

+62
-59
lines changed

access-add-in/AccUnitLoader.accda

0 Bytes
Binary file not shown.
Lines changed: 1 addition & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -1,5 +1,2 @@
1-
CREATE TABLE [ACLib_ConfigTable] (
2-
[PropName] VARCHAR (255) CONSTRAINT [PK_ACLib_ConfigTable] PRIMARY KEY UNIQUE NOT NULL,
3-
[PropValue] VARCHAR (255),
4-
[PropRemarks] LONGTEXT
1+
CREATE TABLE [ACLib_ConfigTable]
52
)
Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -1,6 +1,6 @@
11
CREATE TABLE [USysRegInfo] (
22
[Subkey] VARCHAR (255),
3-
[Type] LONG ,
3+
[Type] LONG,
44
[ValName] VARCHAR (255),
55
[Value] VARCHAR (255)
66
)

access-add-in/AccUnitLoader.accda.src/tbldefs/USys_AppFiles.sql

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -2,6 +2,6 @@
22
[id] VARCHAR (50),
33
[BitInfo] VARCHAR (255),
44
[version] VARCHAR (20),
5-
[file] LONGBINARY ,
5+
[file] LONGBINARY,
66
CONSTRAINT [PrimaryKey] PRIMARY KEY ([id], [BitInfo])
77
)
Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -1,4 +1,4 @@
11
CREATE TABLE [tab1DS] (
2-
[id] BIT CONSTRAINT [PrimaryKey] PRIMARY KEY UNIQUE NOT NULL,
3-
[ShowInfoForm] BIT
2+
[id] BIT CONSTRAINT [PrimaryKey] PRIMARY KEY UNIQUE NOT NULL,
3+
[ShowInfoForm] BIT
44
)

access-add-in/source/modules/modTypeLibCheck.bas

Lines changed: 57 additions & 51 deletions
Original file line numberDiff line numberDiff line change
@@ -1,4 +1,4 @@
1-
Attribute VB_Name = "modTypeLibCheck"
1+
Attribute VB_Name = "modTypeLibCheck"
22
'---------------------------------------------------------------------------------------
33
' Module: modTypeLibCheck
44
'---------------------------------------------------------------------------------------
@@ -18,49 +18,85 @@
1818
'</codelib>
1919
'---------------------------------------------------------------------------------------
2020
'
21-
Option Compare Database
21+
Option Compare Text
2222
Option Explicit
23+
Option Private Module
2324

24-
#Const EARLYBINDING = 0
25+
#Const EARLYBINDING = 1
2526

2627
Private Const EXTENSION_KEY_APPFILE As String = "AppFile"
2728

2829
Public Property Get DefaultAccUnitLibFolder() As String
29-
DefaultAccUnitLibFolder = CodeProject.Path & "\lib"
30+
Dim FilePath As String
31+
FilePath = CodeVBProject.FileName
32+
FilePath = VBA.Left(FilePath, VBA.InStrRev(FilePath, "\"))
33+
DefaultAccUnitLibFolder = FilePath & "lib"
3034
End Property
3135

32-
Public Sub CheckAccUnitTypeLibFile()
36+
Public Sub CheckAccUnitTypeLibFile(ByVal VBProjectRef As VBProject, Optional ByRef ReferenceFixed As Boolean)
3337

3438
Dim LibPath As String
3539
Dim LibFile As String
36-
37-
LibPath = DefaultAccUnitLibFolder & "\"
40+
Dim FileFixed As Boolean
41+
42+
LibPath = GetAccUnitLibPath(True)
3843
LibFile = LibPath & ACCUNIT_TYPELIB_FILE
39-
4044
FileTools.CreateDirectory LibPath
4145

4246
If Not FileTools.FileExists(LibFile) Then
47+
FileFixed = True
4348
ExportTlbFile LibFile
4449
End If
4550

46-
4751
On Error Resume Next
48-
CheckMissingReference
52+
CheckMissingReference VBProjectRef, ReferenceFixed
53+
54+
ReferenceFixed = ReferenceFixed Or FileFixed
4955

5056
End Sub
5157

58+
Private Function GetAccUnitLibPath(Optional ByVal BackSlashAtEnd As Boolean = False) As String
59+
60+
Dim LibPath As String
61+
Dim LibFile As String
62+
63+
With CurrentAccUnitConfiguration
64+
On Error GoTo ErrMissingPath
65+
LibPath = .AccUnitDllPath
66+
On Error GoTo 0
67+
End With
68+
69+
If VBA.Len(LibPath) = 0 Then
70+
LibPath = DefaultAccUnitLibFolder
71+
End If
72+
73+
If BackSlashAtEnd Then
74+
If VBA.Right(LibPath, 1) <> "\" Then
75+
LibPath = LibPath & "\"
76+
End If
77+
End If
78+
79+
GetAccUnitLibPath = LibPath
80+
81+
Exit Function
82+
83+
ErrMissingPath:
84+
Resume Next
85+
86+
End Function
87+
5288
Private Sub ExportTlbFile(ByVal LibFile As String)
5389
With CurrentApplication.Extensions(EXTENSION_KEY_APPFILE)
54-
.CreateAppFile ACCUNIT_TYPELIB_FILE, LibFile
90+
.CreateAppFile ACCUNIT_TYPELIB_FILE, LibFile, "BitInfo", CStr(GetCurrentVbaBitSystem)
5591
End With
5692
End Sub
5793

58-
Private Sub CheckMissingReference()
94+
Private Sub CheckMissingReference(ByVal VBProjectRef As VBProject, Optional ByRef ReferenceFixed As Boolean)
5995

6096
Dim AccUnitRefExists As Boolean
6197
Dim ref As Object
6298

63-
With CodeDbProject
99+
With VBProjectRef
64100
For Each ref In .References
65101
If ref.Name = "AccUnit" Then
66102
AccUnitRefExists = True
@@ -69,56 +105,26 @@ Private Sub CheckMissingReference()
69105
Next
70106
End With
71107

72-
AddAccUnitTlbReference
108+
AddAccUnitTlbReference VBProjectRef
109+
ReferenceFixed = True
73110

74111
End Sub
75112

76-
Private Sub AddAccUnitTlbReference()
77-
CodeDbProject.References.AddFromFile CodeProject.Path & "\lib\" & ACCUNIT_TYPELIB_FILE
113+
Private Sub AddAccUnitTlbReference(ByVal VBProjectRef As VBProject)
114+
VBProjectRef.References.AddFromFile GetAccUnitLibPath(True) & ACCUNIT_TYPELIB_FILE
78115
End Sub
79116

80-
Private Sub RemoveAccUnitTlbReference()
117+
Private Sub RemoveAccUnitTlbReference(ByVal VBProjectRef As VBProject)
81118

82119
Dim ref As Object
83120

84-
For Each ref In CodeDbProject.References
121+
For Each ref In VBProjectRef.References
85122
If ref.IsBroken Then
86-
CodeDbProject.References.Remove ref
123+
VBProjectRef.References.Remove ref
87124
ElseIf ref.Name = "AccUnit" Then
88-
CodeDbProject.References.Remove ref
125+
VBProjectRef.References.Remove ref
89126
Exit Sub
90127
End If
91128
Next
92129

93130
End Sub
94-
95-
#If EARLYBINDING Then
96-
Private Property Get CodeDbProject() As VBIDE.VBProject
97-
#Else
98-
Private Property Get CodeDbProject() As Object
99-
#End If
100-
101-
#If EARLYBINDING Then
102-
Dim Proj As VBProject
103-
#Else
104-
Dim Proj As Object
105-
#End If
106-
Dim strCodeDbName As String
107-
Dim objCodeVbProject As Object
108-
109-
Set objCodeVbProject = VBE.ActiveVBProject
110-
'Prüfen, ob das richtige VbProject gewählt wurde (muss das von CodeDb sein)
111-
strCodeDbName = UncPath(CodeDb.Name)
112-
If objCodeVbProject.FileName <> strCodeDbName Then
113-
Set objCodeVbProject = Nothing
114-
For Each Proj In VBE.VBProjects
115-
If Proj.FileName = strCodeDbName Then
116-
Set objCodeVbProject = Proj
117-
Exit For
118-
End If
119-
Next
120-
End If
121-
122-
Set CodeDbProject = objCodeVbProject
123-
124-
End Property

0 commit comments

Comments
 (0)