ExcelBanter

ExcelBanter (https://www.excelbanter.com/)
-   Excel Programming (https://www.excelbanter.com/excel-programming/)
-   -   Programmatically Add Reference` (https://www.excelbanter.com/excel-programming/277111-re-programmatically-add-reference%60.html)

keepITcool

Programmatically Add Reference`
 
John,

This should solve it...

If it cannot find a valid reference:
It queries the registry for the installed version of outlook.
then looksup the typelibrary and sets a reference.

(you cant use excel's version e.g. i have excel 11 but use
outlook 10)

It doesnot require a reference to VBIDE.
but user MUST allow access to project in macro security

You may have to add some errorhandling...:)


Option Explicit

'ADVAPI32
Private Declare Function RegOpenKeyEx Lib "advapi32.dll" _
Alias "RegOpenKeyExA" ( _
ByVal hKey As Long, ByVal lpSubKey As String, _
ByVal ulOptions As Long, ByVal samDesired As Long, _
phkResult As Long) As Long
Private Declare Function RegQueryValueEx Lib "advapi32.dll" _
Alias "RegQueryValueExA" ( _
ByVal hKey As Long, ByVal lpValueName As String, _
ByVal lpReserved As Long, lpType As Long, lpData As Any, _
lpcbData As Long) As Long
Private Declare Function RegCloseKey Lib "advapi32.dll" ( _
ByVal hKey As Long) As Long


Function getRegistry(sName$) As String
Dim lKey&, lBuf&, sBuf$, lRes&
Const HKEY_CLASSES_ROOT = &H80000000
Const RegAccessRead = &H20019

lRes = RegOpenKeyEx(HKEY_CLASSES_ROOT, sName, 0&, RegAccessRead, lKey)
If lRes = 0 Then
lBuf = 255
sBuf = Space(lBuf)
lRes = RegQueryValueEx(lKey, "", 0&, &H1, ByVal sBuf, lBuf)
lRes = RegCloseKey(lKey)
getRegistry = Left(sBuf, lBuf - 1)
End If
End Function


Sub CheckAndSetReference()
Dim ref As Object
Dim bOK As Boolean
Dim sGuid As String

With Application.VBE.ActiveVBProject
On Error Resume Next
Set ref = .References("Outlook")
On Error GoTo 0
If Not ref Is Nothing Then
If ref.IsBroken = False Then
bOK = True
Else
.References.Remove ref
End If
End If

If Not bOK Then
sGuid = getRegistry("Outlook.Application\CLSID")
sGuid = getRegistry("\CLSID\" & sGuid & "\Typelib")
If sGuid = "" Then
MsgBox "Cant add reference to Outlook object Library"
Else
.References.AddFromGuid sGuid, 0, 0
End If
End If
End With
End Sub


keepITcool

< email : keepitcool chello nl (with @ and .)
< homepage: http://members.chello.nl/keepitcool


"JohnV" wrote:

I have a spreadsheet that will be used by different
Admins. As they have varying levels of technical
knowledge I would like to be able to check the references
when the workbook is opened and see if the references
to "Microsoft Outlook X.X Library" is checked. As the
users can be using Office 97, 2000 or XP and I am not sure
exactly what reference I am looking for; I probably need
to check for all 3. Additionally, I am not sure where the
reference library would be kept, so I would like to refer
to the Library name rather than the location.

Could anybody help me with this?

Thanks,
JohnV



johnV

Programmatically Add Reference`
 
Thanks for the code. I am getting an error at this
portion of code:
.References.AddFromGuid sGuid, 0, 0

The error states that the object library is not registered:
Run-time error '-2147319779(8002801d)':
Object library not registered
Any ideas on why this is happening?

Additionally, on Winnt the first line of code below is
found but the second line of code is blank:
sGuid = getRegistry("Outlook.Application\CLSID")
sGuid = getRegistry("\CLSID\" & sGuid & "\Typelib")

Thanks,
JohnV

-----Original Message-----
John,

This should solve it...

If it cannot find a valid reference:
It queries the registry for the installed version of

outlook.
then looksup the typelibrary and sets a reference.

(you cant use excel's version e.g. i have excel 11 but

use
outlook 10)

It doesnot require a reference to VBIDE.
but user MUST allow access to project in macro security

You may have to add some errorhandling...:)


Option Explicit

'ADVAPI32
Private Declare Function RegOpenKeyEx Lib "advapi32.dll" _
Alias "RegOpenKeyExA" ( _
ByVal hKey As Long, ByVal lpSubKey As String, _
ByVal ulOptions As Long, ByVal samDesired As Long, _
phkResult As Long) As Long
Private Declare Function RegQueryValueEx

Lib "advapi32.dll" _
Alias "RegQueryValueExA" ( _
ByVal hKey As Long, ByVal lpValueName As String, _
ByVal lpReserved As Long, lpType As Long, lpData As

Any, _
lpcbData As Long) As Long
Private Declare Function RegCloseKey Lib "advapi32.dll" (

_
ByVal hKey As Long) As Long


Function getRegistry(sName$) As String
Dim lKey&, lBuf&, sBuf$, lRes&
Const HKEY_CLASSES_ROOT = &H80000000
Const RegAccessRead = &H20019

lRes = RegOpenKeyEx(HKEY_CLASSES_ROOT, sName, 0&,

RegAccessRead, lKey)
If lRes = 0 Then
lBuf = 255
sBuf = Space(lBuf)
lRes = RegQueryValueEx(lKey, "", 0&, &H1, ByVal sBuf,

lBuf)
lRes = RegCloseKey(lKey)
getRegistry = Left(sBuf, lBuf - 1)
End If
End Function


Sub CheckAndSetReference()
Dim ref As Object
Dim bOK As Boolean
Dim sGuid As String

With Application.VBE.ActiveVBProject
On Error Resume Next
Set ref = .References("Outlook")
On Error GoTo 0
If Not ref Is Nothing Then
If ref.IsBroken = False Then
bOK = True
Else
.References.Remove ref
End If
End If

If Not bOK Then
sGuid = getRegistry("Outlook.Application\CLSID")
sGuid = getRegistry("\CLSID\" & sGuid & "\Typelib")
If sGuid = "" Then
MsgBox "Cant add reference to Outlook object

Library"
Else
.References.AddFromGuid sGuid, 0, 0
End If
End If
End With
End Sub


keepITcool

< email : keepitcool chello nl (with @ and .)
< homepage: http://members.chello.nl/keepitcool


"JohnV" wrote:

I have a spreadsheet that will be used by different
Admins. As they have varying levels of technical
knowledge I would like to be able to check the

references
when the workbook is opened and see if the references
to "Microsoft Outlook X.X Library" is checked. As the
users can be using Office 97, 2000 or XP and I am not

sure
exactly what reference I am looking for; I probably

need
to check for all 3. Additionally, I am not sure where

the
reference library would be kept, so I would like to

refer
to the Library name rather than the location.

Could anybody help me with this?

Thanks,
JohnV


.



All times are GMT +1. The time now is 08:46 AM.

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
ExcelBanter.com