View Single Post
  #16   Report Post  
Posted to microsoft.public.excel.programming
RB Smissaert RB Smissaert is offline
external usenet poster
 
Posts: 2,452
Default Foolproof way to add ADO reference

I have added your find (ref successfully added, but faulty as .FullPath
doesn't work) now to my function.
Looks this is a bit more foolproof then, but I am interested if anybody can
still see holes in this.

Function AddProjectReference(Optional strGUID As String, _
Optional lMajor As Long, _
Optional lMinor As Long, _
Optional strRefName As String = "", _
Optional bRemove As Boolean, _
Optional bRemoveAndAdd As Boolean, _
Optional bArray As Boolean, _
Optional vGUIDArray As Variant, _
Optional strObjectString As String, _
Optional strWorkbook As String, _
Optional strFilePath As String, _
Optional bMessage As Boolean = True) As Boolean

Dim oRef As Object
Dim VBProj As VBProject
Dim i As Byte
Dim bSuccess As Boolean

If Len(strWorkbook) = 0 Then
strWorkbook = ThisWorkbook.Name
End If

Set VBProj = Workbooks(strWorkbook).VBProject

'removing references
'-------------------
For Each oRef In VBProj.References
If oRef.Name = strRefName Then
If oRef.IsBroken Then
'so remove any broken references
'-------------------------------
VBProj.References.REMOVE oRef
Else
If bRemove Or bRemoveAndAdd Then
VBProj.References.REMOVE oRef
If bRemove Then
AddProjectReference = True
End If
End If
End If
End If
Next

If bRemove Then
Exit Function
End If

'adding references
'-----------------
If Len(strFilePath) = 0 Then
'not adding directly from file
'-----------------------------
If Len(strObjectString) = 0 Then
If bArray Then 'trying an array of GUID's and version numbers
On Error Resume Next
For i = 1 To UBound(vGUIDArray)
Set oRef = VBProj.References.AddFromGuid(GUID:=vGUIDArray(i,
1), _
Major:=vGUIDArray(i,
2), _
Minor:=vGUIDArray(i,
3))
If Err.Number = 0 Then
bSuccess = Len(oRef.FullPath) 0
If bSuccess Then
AddProjectReference = True
WriteIniValue strINIPath, _
"Add-in behaviour", _
"ADO reference added", _
vGUIDArray(i, 2) & "." & vGUIDArray(i, 3)
Exit Function
Else
VBProj.References.REMOVE oRef
End If
End If
Next
GoTo ERROROUT 'as we couldn't add any of the references
Else
On Error Resume Next
Set oRef = VBProj.References.AddFromGuid(GUID:=strGUID, _
Major:=lMajor, _
Minor:=lMinor)
If Err.Number = 0 Then
bSuccess = Len(oRef.FullPath) 0 'just for in case the len
is 0 without error
If bSuccess Then
AddProjectReference = True 'as we got here without an
error
Else
VBProj.References.REMOVE oRef
GoTo ERROROUT
End If
End If
End If
Else
'adding from file via registry reads
'-----------------------------------
On Error GoTo ERROROUT
AddProjectReference = AddRefFromFileWithRegReads(strObjectString,
strWorkbook)
End If
Else
'adding directly from file
'-------------------------
On Error Resume Next
If bFileExistsVBA(strFilePath) Then
Set oRef = VBProj.References.AddFromFile(strFilePath)
If Err.Number = 0 Then
bSuccess = Len(oRef.FullPath) 0
If bSuccess Then
AddProjectReference = True
Else
VBProj.References.REMOVE oRef
GoTo ERROROUT
End If
End If
Else
If bMessage Then
MsgBox "Couldn't add the " & strRefName & " reference as the
file:" & _
vbCrLf & _
strFilePath & vbCrLf & _
"is missing." & vbCrLf & vbCrLf & _
"Run the installer on this PC", vbExclamation, _
"adding " & strRefName & " reference"
End If
End If
End If

If bRemove = False Then
WriteIniValue strINIPath, _
"Add-in behaviour", _
"Added " & strRefName & " library file path", _
oRef.FullPath
End If

Exit Function
ERROROUT:

If bMessage Then
MsgBox "Couldn't add the " & strRefName & " reference", , _
"adding references to VB Project"
End If
On Error GoTo 0

End Function


It can't work without the other functions, but you will get the idea.
Thanks for that suggestion, it may be useful.


RBS

"Peter T" <peter_t@discussions wrote in message
...
Hi Bart,

Although I already knew my 2.8 is problematic it's only today I've found
out
trying to return it's path throws the error. Not sure why I can return
other
info' about it, such as Name, Description, Major, Minor etc. So in your
routine need to remove the 'bad' ref before trying lower versions.

Which reminds me, if I (anyone) runs your routine twice, the second time
user will get the error message because trying to add the ref when one
already exists throws the error. I suppose that shouldn't occur because
you
set a flag in your ini, but...?

What are you using ADO for?


Not much !

Regards,
Peter T

"RB Smissaert" wrote in message
...
Hi Peter,

OK, I got you.
You are trying to test for a reference that was set, but that somehow is

not
right.
I think that makes sense, and maybe the way you do it is a good way.
I always have the option though if things don't work out to set the path

to
the right file
via my .ini.
Still, it is nice if such a thing could be avoided as it would involve
contacting me etc.
What are you using ADO for?

RBS


"Peter T" <peter_t@discussions wrote in message
...
Hi Bart,

I wouldn't want to suggest you leave out 2.8, not sure what the problem

is
with it in my system and probably unusual. No idea if it's relates to

the
reason your user fails.

I modified your function and it succeeded it correctly adding v2.7
after
first adding the problematic 2.8.

Function AddReferenceFromFile( blah
Dim oRef As Object ' Reference
' code

On Error Resume Next
Set oRef = VBProj.References.AddFromFile(strFilePath)

' AddReferenceFromFile = True
AddReferenceFromFile = Len(oRef.fullPath) 0

If Err.Number Then
If Not oRef Is Nothing Then
VBProj.References.Remove oRef ' this removed my 2.8
End If
Else
AddReferenceFromFile = True
End If

Regards,
Peter T

wrote in message
oups.com...
Hi Peter,

My customers ( 100 ) have been using this routine now for a week and
sofar
I haven't heard about any problems. Are you suggesting I should leave
the 2.8
option out?

RBS

Peter T wrote:
Hi Bart,

Yes I had noticed (later) the function didn't return True on
success.
However that doesn't change what I reported earlier about v2.8 not
working
correctly in my system. Trying to debug its Fullpath (after setting

the
ref)
errors.

In my XL2000 looking at tools ref's v2.8 is checked and looks

correct
(but
I know it will cause problems).
I ran same code in XL97, v2.8 is also checked but marked MISSING.

Regards,
Peter


wrote in message
ups.com...
Peter,

Just noticed that the function misses this line at the end:

AddReferenceFromFile = True

Before Exit Function

Try again with that added.

RBS


Peter T wrote:
Hi Bart,

Your add ado ref routine both worked and failed getting your

error
message.
Somehow it managed to add the ref to v2.8 though as far as I
know
this
version is not correctly registered on my system. It doesn't
normally
appear
in tools ref's and things have gone wrong in the past using

other
people's
wb's with this ref. So I always end up changing to 2.7 or rather
2.5
which
for some reason I find more reliable.

As I say it added the 2.8 ref but when I did this

' r = a vba ref to v2.8
Debug.Print r.Name, r.Description, r.Major, r.Minor
ADODB Microsoft ActiveX Data Objects 2.8 Library 2 8

Debug.Print r.FullPath
' this fails !!
debug.print err, err.description
-2147319779 Method 'FullPath' of object 'Reference' failed

If I change the ref to v2.7 both debug lines work
ADODB Microsoft ActiveX Data Objects 2.7 Library 2 7
C:\Program Files\Common Files\System\ado\msado27.tlb

Maybe something similar to your user.

I have two versions of msado15.dll on my system, one an old v1.5
and
the
newer 2.8 (why is it the 2.8 version named msado15.dll ! I also
have
all
the
other versions in your list.

FWIW I recall having problems when trying to upgrade to 2.8, it

was
a
while
ago.

Regards,
Peter T

PS I commented out your code to get file name from an ini and

did -
strADOPathFromINI = ThisWorkbook.Name

"RB Smissaert" wrote in message
...
Trying to come up with a foolproof way to add the current ADO
library
to
the
project's references.

I used to do this by just saving the .xla with a reference to
a
low
version,
2.5 and that worked fine for
a long time, but then came across a user where this failed.

Then I had a method that got the ADO library file path from
registry
reads
using code from KeepITCool:

Function GetLibrary(sProgID$) As String
Dim oReg As Object, sDat$
Const HKCR = &H80000000
Set oReg = GetObject( _


"winmgmts:{impersonationLevel=impersonate}!\\.\roo t\default:StdRegProv")
oReg.getstringvalue _
HKCR, sProgID & "\CLSID", vbNullString, sDat
oReg.getstringvalue _
HKCR, "CLSID\" & sDat & "\Inprocserver32", vbNullString, sDat
GetLibrary = sDat
End Function

Except I re-wrote this by using the Windows API.
This solved this one user's problem, but it failed with
others,
not
exactly
sure why.

Currently I use this method:
Save the .xla with the lowest ADO version I have on my
development
machine,
2.1
In the Workbook_Open event remove this reference and add the
current
library
like this,
slightly simplified:

Function AddReferenceFromFile(strFilePath As String, _
Optional strWorkbook As String)

As
Boolean

Dim VBProj As VBProject

On Error GoTo ERROROUT

If Len(strWorkbook) = 0 Then
strWorkbook = ThisWorkbook.Name
End If

Set VBProj = Workbooks(strWorkbook).VBProject

VBProj.References.AddFromFile strFilePath

Exit Function
ERROROUT:

End Function


Sub SetADOReference()

Dim i As Byte
Dim ADOConn As Object
Dim strADOVersion As String
Dim strADOFolder As String
Dim strADOFile As String
Dim strADOPathFromINI As String
Dim arrADOFiles

Const strINIPath As String = "C:\test.ini"

strADOPathFromINI = ReadINIValue(strINIPath, _
"Add-in behaviour", _
"Full path to ADO
library")

If InStr(1, strADOPathFromINI, ":\", vbBinaryCompare) 0

Then
If AddReferenceFromFile(strADOPathFromINI) = True Then
Exit Sub
End If
End If

strADOFolder = Left$(Application.Path, 1) & _
":\Program Files\Common Files\System\ADO\"

Set ADOConn = CreateObject("ADODB.Connection")
strADOVersion = Left$(ADOConn.Version, 3)
Set ADOConn = Nothing

Select Case strADOVersion
Case "2.8"
strADOFile = "msado15.dll"
Case "2.7"
strADOFile = "msado27.tlb"
Case "2.6"
strADOFile = "msado26.tlb"
Case "2.5"
strADOFile = "msado25.tlb"
Case "2.1"
strADOFile = "msado21.tlb"
Case "2.0"
strADOFile = "msado20.tlb"
End Select

If AddReferenceFromFile(strADOFolder & strADOFile) = True

Then
Exit Sub
End If

arrADOFiles = Array("msado15.dll", "msado27.tlb",
"msado26.tlb", _
"msado25.tlb", "msado21.tlb",
"msado20.tlb")

For i = 0 To 5
If AddReferenceFromFile(strADOFolder & arrADOFiles(i)) =
True
Then
Exit Sub
End If
Next

MsgBox "Failed to add the ADO reference" & vbCrLf & vbCrLf
&

_
"Please contact Bart Smissaert:
",
_
vbExclamation, "adding ADO reference"

End Sub


Sofar this seems to work fine. I know it is overkill, but as

this
is
so
tricky I can't be
careful enough. The .ini file read should always make it

possible
for
the
user to
set the right path, but this can be skipped for starters.
I am not 100% sure the Select Case sequence is right, but then
there
always
is the brute force
method with the array.

Have read a lot of postings about this problem, but there

doesn't
seem
to
be
any definite, single best
way how to tackle this.
Any pitfalls here or any suggestions for improvement?


RBS