Project

General

Profile

Bug #2708 ยป addExcelRef.vba

Michael Lee, 12/22/2006 05:59 PM

 
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

    
    (1-1/1)