remove add-in entry via registry

[RB Smissaert]

Does anybody have a clear example of how to remove an add-in from
the list that appears under Tools, Add-ins?
I would like to do this with API calls to the registry, but I can't find any
good example of this.
Thanks for any assistance.

RBS

[keepITcool]

Bart...

This was written in VB6 and compiled into a small exe
it will install or uninstall addins based on commandline paramters

AND will do it for all versions of excel on the PC.
Have a look and take what you need.

Cheerz!

Option Explicit
Option Compare Text

Const sFILE = "MyAddinV1.xla"
Const sMASK = "*MyAddin*"
Const sAPPL = "My Application"
Const sVBAREGAPP = "My Application"
Const sVBAREGKEY = "Settings"

'KERNEL32
Private Declare Function GetLocaleInfo Lib "kernel32" Alias
"GetLocaleInfoA" (ByVal Locale As Long, ByVal LCType As Long, ByVal
lpLCData As String, ByVal cchData As Long) As Long
'USER32
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA"
(ByVal lpClassName As String, ByVal lpWindowName As String) As Long
'ADVAPI32
Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As
Long) As Long
Private Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias
"RegOpenKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal
Reserved As Long, ByVal samDesired As Long, phkResult As Long) As Long
Private Declare Function RegCreateKey Lib "advapi32.dll" Alias
"RegCreateKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult
As Long) As Long

Private Declare Function RegEnumValue Lib "advapi32.dll" Alias
"RegEnumValueA" (ByVal hKey As Long, ByVal dwIndex As Long, ByVal
lpValueName As String, lpcbValueName As Long, ByVal lpReserved As Long,
lpType As Long, lpData As Any, lpcbData As Long) As Long
Private Declare Function RegSetValueEx Lib "advapi32.dll" Alias
"RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal
Reserved As Long, ByVal dwType As Long, lpData As Any, ByVal cbData As
Long) As Long
Private Declare Function RegDeleteValue Lib "advapi32.dll" Alias
"RegDeleteValueA" (ByVal hKey As Long, ByVal lpValueName As String) As
Long

Sub Main()
Dim bUndo As Boolean
Dim sFull$, lRet&, lErr&

'Read command line parameters
'Usage: /i or /u
On Error GoTo TheEnd
If InStr(Command$, "/i") > 0 Then
bUndo = False
ElseIf InStr(Command$, "/u") > 0 Then
bUndo = True
Else
Select Case MsgBox("Register & Activate " & sAPPL & "addin?" &
vbNewLine & "Yes=Install, No=Uninstall", vbYesNoCancel)
Case vbCancel
Exit Sub
Case vbNo
bUndo = True
End Select
End If

sFull = App.Path & "\" & sFILE
'Verify files (only needed for Install?)
If Dir(sFull) = "" And Not bUndo Then
lRet = 1
Else
While Excel_IsOpen
If vbCancel = MsgBox("Close Excel, then press OK.",
vbOKCancel) Then Exit Sub
DoEvents
Wend
lRet = Install_Addin(bUndo, sFull, sMASK)
End If

TheEnd:
On Error Resume Next
Select Case lRet
Case True
If bUndo Then
MsgBox sAPPL & " removed from registry"
Else
MsgBox sAPPL & " addin registered & activated"
End If
Case 1: MsgBox "error: File not found " & sFull
Case 2: MsgBox "error: Registry permissions"
Case Else: MsgBox "unspecified error"
End Select

End Sub

Private Function Install_Addin(ByVal bUndo As Boolean, ByVal sFull$,
ByVal sMASK$) As Long
Const HKCU& = &H80000001
Const HKMS$ = "Software\Microsoft\Office"

Const KEY_ALL_ACCESS = &H2003F
Const ERROR_NO_MORE_ITEMS = &H103
Const BUFFER_SIZE = 256

Dim sKey As String 'name of hive
Dim hKey As Long 'long pointer to hive
Dim lName As Long 'long pointer to SName
Dim lData As Long 'long pointer to sData

Dim sName As String 'Text for Name column in Registry
Dim sData As String 'Text for Data column in Registry

Dim vVers As Variant
Dim vOpen As Variant

Dim lCtr As Long
Dim lErr As Long
Dim lRet As Long
Dim bDone As Boolean

Dim cInst As Collection 'collection of installed excel versions
Dim cOpen As Collection 'collection of activated addins

'Init collections
Set cInst = New Collection
Set cOpen = New Collection

'Check if the office key exists and if we've got enough permissions
lRet = RegOpenKeyEx(HKCU, HKMS, 0&, KEY_ALL_ACCESS, hKey)
If lRet <> 0 Then
lErr = 1
GoTo errH
Else
RegCloseKey hKey
End If

'Loop possible versions
For Each vVers In Array("11.0", "10.0", "9.0", "8.0")

'Find installed addins
sKey = HKMS & "\" & vVers & "\Excel"
lRet = RegOpenKeyEx(HKCU, sKey, 0&, KEY_ALL_ACCESS, hKey)

If lRet <> 0 Then
'ok.. this version is not installed
Else
cInst.Add vVers
'Get the key to the addins
RegCloseKey hKey
lRet = RegOpenKeyEx(HKCU, sKey & "\Add-in Manager", 0&,
KEY_ALL_ACCESS, hKey)
If lRet <> 0 Then
'get parent
lRet = RegOpenKeyEx(HKCU, sKey, 0&, KEY_ALL_ACCESS,
hKey)
'create the key
lRet = RegCreateKey(hKey, "Add-in Manager", hKey)
Else
'enumerate installed
bDone = False
lCtr = 0

Do
GoSub bufInit
lRet = RegEnumValue(hKey, lCtr, sName, lName, 0,
ByVal 0&, ByVal sData, lData)
If lRet = 0 Then
If lName > 0 Then
sName = Left$(sName, lName)
sData = Left$(sData, IIf(lData > 0, lData -
1, 0))
If sName Like sMASK Then
If StrComp(sName, sFull, vbTextCompare)
= 0 Then
If bUndo Then
RegDeleteValue hKey, sName
Else
bDone = True
End If
Else
RegDeleteValue hKey, sName
End If
End If
End If
End If
lCtr = lCtr + 1
Loop Until lRet <> 0
End If

If hKey <> 0 And Not (bDone Or bUndo) Then
sName = sFull
sData = vbNullString
RegSetValueEx hKey, sName, 0, 1, ByVal sData, Len(sData)
End If

RegCloseKey hKey

'----------------------------
'now do the opened addins
sKey = HKMS & "\" & vVers & "\Excel" & IIf(vVers = "8.0",
"\Microsoft Excel", "\Options")
lRet = RegOpenKeyEx(HKCU, sKey, 0, KEY_ALL_ACCESS, hKey)
If lRet = 0 Then
'init
Set cOpen = New Collection

'enumerate activated
lCtr = 0
Do
GoSub bufInit
lRet = RegEnumValue(hKey, lCtr, sName, lName, 0&,
ByVal 0&, ByVal sData, lData)
If lName > 0 Then
sName = Left$(sName, lName)
sData = Left$(sData, IIf(lData > 0, lData - 1,
0))
If sName Like "open*" Then
'kill it
RegDeleteValue hKey, sName
'save it if non-synk
If Not sData Like sMASK Then
cOpen.Add sData
End If
End If
End If
lCtr = lCtr + 1
Loop Until lRet = ERROR_NO_MORE_ITEMS

lCtr = 0
'(Re)write all items
If Not bUndo Then cOpen.Add """" & sFull & """"

For Each vOpen In cOpen
sName = "OPEN" & IIf(lCtr = 0, "", lCtr)
sData = vOpen
lRet = RegSetValueEx(hKey, sName, 0, 1&, ByVal
sData, Len(sData))
lCtr = lCtr + 1
Next
End If
RegCloseKey hKey

End If
Next

'CleanUp "VBA" settings
If bUndo Then
If Not IsEmpty(GetAllSettings(sVBAREGAPP, sVBAREGKEY)) Then
DeleteSetting sVBAREGAPP, sVBAREGKEY
End If
If cInst.Count > 0 Then Install_Addin = True

endh:
If hKey <> 0 Then RegCloseKey hKey
Exit Function

bufInit:
'initialize buffers
sName = Space(BUFFER_SIZE)
sData = Space(BUFFER_SIZE)
lName = BUFFER_SIZE
lData = BUFFER_SIZE
Return

errH:
Install_Addin = lErr
GoTo endh
End Function

Private Function Excel_IsOpen() As Boolean
Excel_IsOpen = (FindWindow("XLMAIN", vbNullString) <> 0)
End Function
Private Function System_Language() As String
Dim sData$, lData& '&H400=user/&H800=system
'when you use the SYSTEM locale you get the language
'of the installed windows version not the language the user has
selected in regional settings
sData = Space(256)
lData = GetLocaleInfo(&H800, &H1001, sData, Len(sData))
If lData > 0 Then System_Language = Left$(sData, lData - 1)
End Function

keepITcool

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

[Jerry W. Lewis]

http://groups.google.com/groups?threadm=387786C6.126922D8%40gmx.at

Jerry

[RB Smissaert]

Thanks for the quick reply.
Will study both and see what I can use.

RBS

"RB Smissaert" <bartsm...@blueyonder.co.uk> wrote in message
news:%23ogsRG3...@TK2MSFTNGP15.phx.gbl...

[RB Smissaert]

keepITcool,

Think I got this now largely worked out.
There is just one bit that won't work with Excel and that is the keyword
Return in the bufInit section
of the function Install_Addin.
Would this translate to Exit Function?

RBS

"keepITcool" <xrrcv...@puryyb.ay> wrote in message
news:Xns95848E43B87...@207.46.248.16...

[RB Smissaert]

keepITcool,

Ignore this question.
Found this out now.

RBS

"RB Smissaert" <bartsm...@blueyonder.co.uk> wrote in message

news:%23a6Ryg4...@TK2MSFTNGP12.phx.gbl...

[Myrna Larson]

Yes, they haven't removed Gosub and Return.

[RB Smissaert]

It is a confusing construction.
Return didn't show in the help, but GoSub did.

RBS

"Myrna Larson" <anon...@discussions.microsoft.com> wrote in message
news:scq2n0lna5bmpmpi6...@4ax.com...