1- Attribute VB_Name = "modTypeLibCheck"
1+ Attribute VB_Name = "modTypeLibCheck"
22'---------------------------------------------------------------------------------------
33' Module: modTypeLibCheck
44'---------------------------------------------------------------------------------------
1818'</codelib>
1919'---------------------------------------------------------------------------------------
2020'
21- Option Compare Database
21+ Option Compare Text
2222Option Explicit
23+ Option Private Module
2324
24- #Const EARLYBINDING = 0
25+ #Const EARLYBINDING = 1
2526
2627Private Const EXTENSION_KEY_APPFILE As String = "AppFile"
2728
2829Public 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"
3034End 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-
4751On Error Resume Next
48- CheckMissingReference
52+ CheckMissingReference VBProjectRef, ReferenceFixed
53+
54+ ReferenceFixed = ReferenceFixed Or FileFixed
4955
5056End 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+
5288Private 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
5692End 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
74111End 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
78115End 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
93130End 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