Re: remove add-in entry via registry
From: keepITcool (xrrcvgpbby_at_puryyb.ay)
Date: 10/16/04
- Next message: Jerry W. Lewis: "Re: Excel Add In - Limited Use?"
- Previous message: Dave Peterson: "Re: change color and protect rows"
- In reply to: RB Smissaert: "remove add-in entry via registry"
- Next in thread: RB Smissaert: "Re: remove add-in entry via registry"
- Reply: RB Smissaert: "Re: remove add-in entry via registry"
- Messages sorted by: [ date ] [ thread ]
Date: Sat, 16 Oct 2004 04:58:50 -0700
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 >
"RB Smissaert" <bartsmissaert@blueyonder.co.uk> wrote:
> 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
>
>
- Next message: Jerry W. Lewis: "Re: Excel Add In - Limited Use?"
- Previous message: Dave Peterson: "Re: change color and protect rows"
- In reply to: RB Smissaert: "remove add-in entry via registry"
- Next in thread: RB Smissaert: "Re: remove add-in entry via registry"
- Reply: RB Smissaert: "Re: remove add-in entry via registry"
- Messages sorted by: [ date ] [ thread ]
Relevant Pages
|
|
