1
|
Option Compare Database
|
2
|
Const CON_EXCEL_REF_GUID = "{00020813-0000-0000-C000-000000000046}"
|
3
|
'the above constant is the excel guid
|
4
|
|
5
|
'----------------------------------------------------------
|
6
|
'adding stuff to deal with references, broken references, etc:
|
7
|
' Looping variable.
|
8
|
'from access Help:
|
9
|
Public Function confirmExcelRegistered()
|
10
|
|
11
|
|
12
|
Dim ref As Reference
|
13
|
Dim blnExcelOK As Boolean
|
14
|
' Enumerate through References collection.
|
15
|
Dim refExcel As Reference, blnExcelBroken As Boolean, strExcelVBAGuid As String
|
16
|
strExcelVBAGuid = CON_EXCEL_REF_GUID
|
17
|
For Each ref In References
|
18
|
' Check IsBroken property.
|
19
|
If ref.IsBroken = False Then
|
20
|
If ref.Guid = strExcelVBAGuid Then
|
21
|
'excel is ok
|
22
|
blnExcelOK = True
|
23
|
End If
|
24
|
' Debug.Print "Name: ", ref.Name
|
25
|
' Debug.Print "FullPath: ", ref.FullPath
|
26
|
' Debug.Print "Version: ", ref.Major & "." & ref.Minor
|
27
|
' Debug.Print "GUID: " & ref.Guid
|
28
|
' Debug.Print "builtin? " & ref.BuiltIn
|
29
|
' Debug.Print "---------------------------"
|
30
|
Else
|
31
|
' Debug.Print "GUIDs of broken references:"
|
32
|
' Debug.Print ref.Guid
|
33
|
' Debug.Print "builtin? " & ref.BuiltIn
|
34
|
If ref.Guid = strExcelVBAGuid Then
|
35
|
Debug.Print "PROBLEM, excel is referenced, but is broken"
|
36
|
blnExcelBroken = True
|
37
|
MsgBox "PROBLEM! Excel has been referenced already from this database, but is no longer accessible (the reference is broken). Did you uninstall Excel or update to a new version? Unfortunately, this means you cannot export from this database into Excel. You need to download a new database and load the contents of this database into it.", vbCritical, CON_APP_TITLE
|
38
|
Set refExcel = ref
|
39
|
End If
|
40
|
|
41
|
End If
|
42
|
Next ref
|
43
|
|
44
|
|
45
|
If Not blnExcelOK Then
|
46
|
If Not blnExcelBroken Then
|
47
|
'try to add it
|
48
|
blnExcelOK = addExcelRef()
|
49
|
End If
|
50
|
End If
|
51
|
|
52
|
confirmExcelRegistered = blnExcelOK
|
53
|
End Function
|
54
|
|
55
|
Private Function addExcelRef() As Boolean
|
56
|
'first try to get the 2003 version, then go down to 2002 and 2000 if that doesn't work, then go up to future versions
|
57
|
|
58
|
Dim intMinor As Integer, intMajor As Integer
|
59
|
intMajor = 1 'default
|
60
|
For intMinor = 5 To 3 Step -1
|
61
|
|
62
|
If tryAddingExcelRef(intMajor, intMinor) Then GoTo exitthisOK
|
63
|
Next intMinor
|
64
|
|
65
|
'keep trying minor version up to 100, then up major versions
|
66
|
For intMinor = 6 To 100
|
67
|
If tryAddingExcelRef(intMajor, intMinor) Then GoTo exitthisOK
|
68
|
Next intMinor
|
69
|
|
70
|
'try a few major versions
|
71
|
For intMajor = 2 To 10
|
72
|
For intMinor = 1 To 100
|
73
|
If tryAddingExcelRef(intMajor, intMinor) Then GoTo exitthisOK
|
74
|
Next intMinor
|
75
|
Next intMajor
|
76
|
'adds 2003
|
77
|
'Application.References.AddFromGuid "{00020813-0000-0000-C000-000000000046}", 1, 4 'adds 2002
|
78
|
'Application.References.AddFromGuid "{00020813-0000-0000-C000-000000000046}", 1, 3 'adds 2000
|
79
|
'didn't work:
|
80
|
addExcelRef = False
|
81
|
GoTo exitthis
|
82
|
|
83
|
''try adding anything else
|
84
|
exitthisOK:
|
85
|
addExcelRef = True
|
86
|
exitthis:
|
87
|
|
88
|
Exit Function
|
89
|
End Function
|
90
|
|
91
|
Private Function tryAddingExcelRef(intMajor, intMinor) As Boolean
|
92
|
'reports whether or not it could be added
|
93
|
On Error GoTo cantAdd
|
94
|
Application.References.AddFromGuid CON_EXCEL_REF_GUID, intMajor, intMinor
|
95
|
|
96
|
Debug.Print "added Excel version: " & intMajor & "." & intMinor; " as reference to this project"
|
97
|
'if we got here, it worked
|
98
|
tryAddingExcelRef = True
|
99
|
|
100
|
exitthis:
|
101
|
Exit Function
|
102
|
|
103
|
cantAdd:
|
104
|
tryAddingExcelRef = False
|
105
|
Resume exitthis
|
106
|
|
107
|
End Function
|
108
|
|