Configuring Excel Automation Add-ins with VBScript

Posted on by
Reply

This is a replica (with better formatting) of a post I made over at ITNinja (or AppDeploy back then!) several years ago which discusses configuring Excel automation add-ins. I’m not even sure if it still works but it’s great as a reference point, so use it at you own risk.

This 5-step tutorial on configuring Excel automation add-ins enables XLA, XLL, XLAM and even COM addins to be automatically installed/removed if they are included in your Windows Installer package. The Custom Actions (CA) will either install EVERY excel add-in in the installer, or just add-ins in a specific directory depending upon how you configure it.

This version:

  • removes the add-in for multiple office versions (97 To 2010)
  • removes the add-in for multiple profiles IF DESIRED
  • installs XLAM add-ins

It still outputs any debugging messages to the windows installer log file. Each debugging line starts with either ‘AddExcelAddinStatus’ or ‘RemoveExcelAddinStatus:’.

This version also contains separate CAs for adding and removing the add-in, because when adding/removing COM add-ins the automation needs to be placed in specific parts of the InstallExecuteSequence.

Configuring Excel Automation Add-ins Step by Step

Step 1 – Create Two Properties

  • Create a property called ‘installAddin’. Give it a default value. I gave mine ‘noaddin’ (It doesn’t really matter what default value you give it)
  • Create a property called ‘removeAddin’. Give it a default value. I gave mine ‘noaddin’

Step 2 – Create Custom Action for Add-In Selection

We can either install every single add-in in the installer, or only install the add-ins which are present in a specified directory (See red font in code)

  • Create a type 38 CA (Embedded VBScript). Call it ‘setAddinProperty’.
  • Schedule it as Immediate, just before InstallInitialize. Do not give it a condition. We want it to Execute on install, uninstall and repair.

Paste the following code into your CA (You should only need to edit the values of blnfilterByDirectory and/or filterDirectory. LEAVE EVERYTHING ELSE ALONE.):

'set blnfilterByDirectory to True if you want to install all add-ins in a specific directory (also specify the directory name below)
'set blnfilterByDirectory to False if you want to install every single add-in in the Installer
Dim blnfilterByDirectory : blnfilterByDirectory = True
'***Important - This directory name is case-sensitive!!!
Dim filterDirectory : filterDirectory = "INSTALLDIR"
'*************************************
'*****DO NOT EDIT BELOW THIS LINE
'*************************************
Dim tempFileName : tempFileName = ""
Dim tempComponent : tempComponent = ""
Dim addinList : addinList = ""
Dim tempExtension : tempExtension = ""
'If we're filtering by directory, construct the sql command accordingly
If blnfilterByDirectory Then
sql = "SELECT File.Component_,File.FileName,Component.Directory_ FROM File, Component WHERE File.Component_ = Component.Component AND Component.Directory_ = '" & filterDirectory & "'"
Else
sql = "SELECT File.Component_,File.FileName,Component.Directory_ FROM File, Component WHERE File.Component_ = Component.Component"
End If
'start searching through file table for add-ins (.XLA or .XLL files)
Set fileView= Session.Database.OpenView(sql)
fileView.Execute
Set fileRecord = fileView.Fetch
While Not fileRecord Is Nothing
tempFileName = LCase(fileRecord.StringData(2))
If InStr(tempFileName,"|") Then 'if filename is currently in sfn form, try and retrieve the full file name
tempFileName = Split(tempFileName,"|")(1)
End If
If InStr(tempFileName,".") Then
tempExtension = Split(tempFileName,".")(1)
End If
If (tempExtension = "xla" Or tempExtension = "xll" Or tempExtension = "xlam") Then 'its an excel addin
'construct list of addins, delimited by commas
addinList = addinList & Session.Property(fileRecord.StringData(3)) & tempFileName & ","
End If
Set fileRecord = fileView.Fetch
Wend
Set fileView = Nothing
Set fileRecord = Nothing
'remove trailing comma
If Len(addinList) > 0 Then
addinList = Left(addinList,Len(addinList)-1)
End If
Property("installAddin") = CStr(addinList)
Property("removeAddin") = CStr(addinList)
'update windows installer session environment and current process with any
'path environment variables found in environment table
Dim tempName : tempName = ""
Dim tempValue : tempValue = ""
Dim tempEnvPath : tempEnvPath = ""
sql = "SELECT Name, Value FROM Environment"
Set envView= Session.Database.OpenView(sql)
envView.Execute
Set envRecord = envView.Fetch
While Not envRecord Is Nothing
tempName = envRecord.StringData(1)
tempValue = envRecord.StringData(2)
If Not Instr(tempName,"!") > 0 Then
'if we're not removing env var on installation
tempName = replace(tempName,"=","")
tempName = replace(tempName,"+","")
tempName = replace(tempName,"-","")
tempName = replace(tempName,"*","")
If lcase(tempName) = "path" Then
If right(tempValue,3) = "[~]" Then
'prefix
tempValue = replace(tempValue,"[~]","")
tempEnvPath = returnEnvironmentPath(tempValue) & ";" & Session.Installer.Environment("Path")
ElseIf left(tempValue,3) = "[~]" Then
'suffix
tempValue = replace(tempValue,"[~]","")
tempEnvPath = Session.Installer.Environment("Path") & ";" & returnEnvironmentPath(tempValue)
Else
'replacement, which 'should' never happen with the path var, but for this we'll set as prefix
tempEnvPath = returnEnvironmentPath(tempValue) & ";" & Session.Installer.Environment("Path")
End If
'replace any double-semis
tempEnvPath = replace(tempEnvPath,";;",";")
'set session env path
Session.Installer.Environment("Path") = tempEnvPath
'make the relevant Path env var available to current process (and processes spawned therein)
Set oShell = CreateObject("WScript.Shell")
Set oProcessEnv = oShell.Environment("PROCESS")
oProcessEnv("Path") = tempEnvPath
Set oProcessEnv = Nothing
Set oShell = Nothing
End If
End If
Set envRecord = envView.Fetch
Wend
Set envView = Nothing
Set envRecord = Nothing
'Function to return 'proper' path for env var
Function returnEnvironmentPath(envPath)
Set objRE = New RegExp
With objRE
.Pattern = "\[.+\]" 'match anything inside and including square brackets Eg [WindowsVolume]
.IgnoreCase = True
.Global = False 'return one instance
End With
' Test method returns TRUE if a match is found
If objRE.Test(envPath) Then
Set objMatch = objRE.Execute(envPath)
strProperty = objMatch.Item(0)
Set objMatch = Nothing
'perform the replacement
strEnvPath = objRE.Replace(envPath, Session.Property(Mid(strProperty,2,Len(strProperty)-2)))
returnEnvironmentPath = strEnvPath
Else
returnEnvironmentPath = envPath
End If
Set objRE = Nothing
End Function

Step 3 – Create CA to install addin

  • Create another Type 38 CA. Call it ‘installAddin’.
  • Schedule it straight after ScheduleReboot, Deferred in a User Context (Setting it as deferred etc makes the Type become 1062 in your CA table).
    Give it a condition of:

NOT Installed Or MaintenanceMode=”Modify”

  • Paste the following code into your CA:
'*************************************
'logic to install addin (can be used for automation addins or COM addins)
'(All status messages are printed to installer log)
'(All log status entries start with 'AddExcelAddinStatus: {status}')
'*************************************
Dim blnReturn : blnReturn = False
Dim objXL
Dim objWorksheet
Dim objAddin
Dim strAddIn : strAddIn = ""
Dim strMsg : strMsg = ""
Dim strAddInName : strAddInName = ""
Dim addinList : addinList = ""
Dim addinListArray : addinListArray = ""
Dim i : i = 0
Const HKEY_LOCAL_MACHINE = &H80000002
Const HKEY_CURRENT_USER = &H80000001
Dim strFirstRun : strFirstRun = ""
Dim strUserData : strUserData = ""
Dim strFirstRunValueName : strFirstRunValueName = ""
Dim blnFoundFirstRun : blnFoundFirstRun = False
Dim dwValue : dwValue = ""
Dim strComputer : strComputer = "."
Dim objRegistry
Dim officeversion
Dim keyCount : keyCount = 0
Dim keyArray(14)
Dim valueCount : valueCount = 0
'cannot redim a multi-dim array so we set the size statically
Dim valueArray(9,1)
'retrieve the value of the property we set earlier
'(The value is comma-separated in the form 'featureInstallState, Addin1, Addin2, Addin3......' etc)
addinList = Session.Property("CustomActionData")
'write value of Session Property to log for debugging purposes
writeToLog("Deferred property contains: " & addinList)
If Len(addinList) > 0 Then 'if we found an add-In
Set objRegistry= GetObject("winmgmts:\\" & strComputer & "\root\default:StdRegProv")
'see if Excel has been opened before
For officeversion = 8 to 14
strFirstRun = "Software\Microsoft\Office\" & officeversion & ".0\Excel\Options"
objRegistry.EnumValues HKEY_CURRENT_USER, strFirstRun, arrValueNames, arrValueTypes
'check if a value is returned
If IsArray(arrValueNames) Then
'if so, loop through values in the registry key
For a=0 To UBound(arrValueNames)
strFirstRunValueName = arrValueNames(a)
'if the value is 'FirstRun', read it
If UCase(strFirstRunValueName) = "FIRSTRUN" Then
objRegistry.GetDWORDValue HKEY_CURRENT_USER,strFirstRun,strFirstRunValueName,dwValue
'if value is not zero, it's not been run for the first time, so we automate it
If CInt(dwValue) <> 0 Then
writeToLog("Excel has not been run for the first time....Firstrun value exists but is not '0'. Setting UserData value to 1....")
End If
'foudn a firstrun entry
blnFoundFirstRun = True
End If
Next
End If
Next
Set objRegistry= Nothing
If Not blnFoundFirstRun Then
'havent found any firstrun value, so excel has not been run
writeToLog("Excel has not been run for the first time....Firstrun value does not exist. Attempting to set UserData value....")
setUserData()
End If
'retrieve addin list
addinListArray = split(addinList,",")
'for every addin, try and add it
For i = 0 To UBound(addinListArray)
'get individual addin full path
strAddInName = Trim(addinListArray(i))
blnReturn = AddExcelAddin(strAddInName)
If Not blnReturn Then
strMsg = "Unable to install Excel add-in '" & strAddInName & "'"
writeToLog(strMsg)
End If
Next
If Not blnFoundFirstRun Then
'resets registry keys so Excel heals agian on first launch
revertRegistry()
End If
Else
strMsg = "No add-ins were found. If you are installing add-ins from a specific directory, check the case of your specified directory in the setAddinProperty CA."
writeToLog(strMsg)
End If
'create and delete a system environment variable to ensure any system environment vars installed with the package
'successfully update on the target system without a reboot
Set wshshell = CreateObject("WScript.Shell")
Set WshSysEnv = wshShell.Environment("SYSTEM")
WshSysEnv("FlushEnvironment") = "default"
WshSysEnv.Remove("FlushEnvironment")
Set WshSySEnv = Nothing
Set wshshell = Nothing
Function setUserData()
'If we write UserData value, Excel will not self-heal if it has not been loaded before. However, if we keep
'the FirstRun value as either not existing, or set to a non-zero value, Excel will still heal when manually loaded.
Set objRegistry= GetObject("winmgmts:\\" & strComputer & "\root\default:StdRegProv")
For oversion = 8 To 14
strUserData = "Software\Microsoft\Office\" & oversion & ".0\"
If objRegistry.EnumKey (HKEY_LOCAL_MACHINE, strUserData & "Excel", arrValueNames) = 0 Then
'if reg key exists, write UserData in HKCU
'create registry key
createRegistryKey HKEY_CURRENT_USER, strUserData & "Excel"
'write dword value
createRegistryValue HKEY_CURRENT_USER,strUserData & "Excel","UserData",1
End If
If objRegistry.EnumKey (HKEY_LOCAL_MACHINE, strUserData & "Common", arrValueNames) = 0 Then
'if reg key exists, write UserData in HKCU
'create registry key
createRegistryKey HKEY_CURRENT_USER, strUserData & "Common"
'write dword value
createRegistryValue HKEY_CURRENT_USER,strUserData & "Common","UserData",1
'create registry key
createRegistryKey HKEY_CURRENT_USER, "Software\ODBC\ODBC.INI\MS Access Database"
End If
Next
Set objRegistry= Nothing
End Function
Function createRegistryKey(hive, path)
If objRegistry.EnumKey (hive, path, arrValueNames) <> 0 Then
'reg key does not exist
return = objRegistry.CreateKey(hive, path)
If (return = 0) And (Err.Number = 0) Then
writeToLog("Created 'HKCU\" & path & "' registry key...")
keyArray(keyCount) = path
keyCount = keyCount + 1
Else
writeToLog("Error creating 'HKCU\" & path & "' registry key...")
On Error GoTo 0
End If
End If
End Function
Function deleteRegistryKey(hive, path)
If objRegistry.EnumKey (hive, path, arrValueNames) = 0 Then
'reg key exists
return = objRegistry.DeleteKey(hive, path)
If (return = 0) And (Err.Number = 0) Then
writeToLog("Deleted 'HKCU\" & path & "' registry key...")
Else
writeToLog("Error deleting 'HKCU\" & path & "' registry key...")
On Error GoTo 0
End If
End If
End Function
Function createRegistryValue(hive, path, valuename, valuedata)
objRegistry.GetDWORDValue hive,path,valuename,valuedata
If IsNull(valuedata) Then
return = objRegistry.SetDWORDValue(hive,path,valuename,valuedata)
If (return = 0) And (Err.Number = 0) Then
writeToLog("Created 'HKCU\" & path & "\" & valuename & "' value...")
valueArray(valueCount,0) = path
valueArray(valueCount,1) = valuename
valueCount = valueCount + 1
Else
writeToLog("Error creating 'HKCU\" & path & "\" & valuename & "' value...")
On Error GoTo 0
End If
End If
End Function
Function deleteRegistryValue(hive, path, valuename)
objRegistry.GetDWORDValue hive,path,valuename,valuedata
If Not IsNull(valuedata) Then
return = objRegistry.DeleteValue(hive,path,valuename)
If (return = 0) And (Err.Number = 0) Then
writeToLog("Deleted 'HKCU\" & path & "\" & valuename & "' value...")
Else
writeToLog("Error deleting 'HKCU\" & path & "\" & valuename & "' value...")
On Error GoTo 0
End If
End If
End Function
'*******************************************
'This function installs the Excel Addin
'*******************************************
Function AddExcelAddin(ByVal strAddIn)
Dim objFSO_XL
Dim intCounter : intCounter = 0
Dim blnInstalledAlready : blnInstalledAlready = False
Dim addinName : addinName = Right(strAddIn,Len(strAddIn)-InStrRev(strAddIn,"\"))
AddExcelAddin = False
Set objFSO_XL = CreateObject("Scripting.FileSystemObject")
With objFSO_XL
strMsg = ""
On Error Resume Next
'Check source file exists
If Not .FileExists(strAddIn) Then
strMsg = "The source file " & strAddIn & " does not exist." & VbCrLf & "'" & strAddIn & "' was not installed."
writeToLog(strMsg)
Exit Function
End If
On Error GoTo 0
End With
On Error Resume Next
'create Excel object
Set objXL = CreateObject("Excel.Application")
If Err.Number <> 0 Then
strMsg = "Failed to create Excel object." & VbCrLf
strMsg = strMsg & "'" & strAddIn & "' was not installed."
writeToLog(strMsg)
On Error GoTo 0
Else
strMsg = "Created Excel object."
writeToLog(strMsg)
End If
'add workbook
Set objWorksheet = objXL.Workbooks.Add()
If Err.Number <> 0 Then
strMsg = "Failed to create new workbook." & VbCrLf
strMsg = strMsg & "'" & strAddIn & "' was not installed."
writeToLog(strMsg)
On Error GoTo 0
Else
strMsg = "Created worksheet object."
writeToLog(strMsg)
End If
'try and add addin
With objXL
For intCounter = 1 to .Addins.Count
If LCase(.Addins(intCounter).Name) = LCase(addinName) Then
If .Addins.Item(intCounter).Installed Then
blnInstalledAlready = True
AddExcelAddin = True
Exit For
End If
End If
Next
If Not blnInstalledAlready Then
Set objAddin = .AddIns.Add(strAddIn)
If Err.Number <> 0 Then
strMsg = ""
strMsg = strMsg & "Error: " & Err.Description & vbCRLF
strMsg = strMsg & "Failed to add add-in '" & strAddIn & "'." & vbCRLF & "'" & strAddIn & "' was not installed."
writeToLog(strMsg)
On Error GoTo 0
Else
objAddin.Installed = True
If Err.Number <> 0 Then
strMsg = ""
strMsg = strMsg & "Error: " & Err.Description & vbCRLF
strMsg = strMsg & "Failed to set add-in installed status." & vbCRLF & "'" & strAddIn & "' was not installed."
writeToLog(strMsg)
Else
strMsg = "Add-in '" & strAddIn & "' installed successfully."
AddExcelAddin = True
writeToLog(strMsg)
End If
End If
Else
strMsg = "Add-in '" & strAddIn & "' is already installed." & vbCRLF & "'" & strAddIn & "' was not installed."
writeToLog(strMsg)
End If		
End With
Set objWorksheet = Nothing
objXL.Quit
Set objFSO_XL = Nothing
Set objAddin = Nothing
Set objXL = Nothing	
End Function
Function revertRegistry()
Set objRegistry= GetObject("winmgmts:\\" & strComputer & "\root\default:StdRegProv")
'deleteRegistryKey(hive, path)
For i = 0 to ubound(keyArray)
If Not CStr(keyArray(i)) = "" Then
deleteRegistryKey HKEY_CURRENT_USER, CStr(keyArray(i))
End If
Next
'deleteRegistryValue(hive, path, valuename)
For i = 0 to UBound(valueArray)
If Not CStr(valueArray(i,0)) = "" Then
deleteRegistryValue HKEY_CURRENT_USER, CStr(valueArray(i,0)), CStr(valueArray(i,1))
End If
Next
Set objRegistry= Nothing
End Function
Const msiMessageTypeInfo = &H04000000
'Subroutine to write to log file
Sub writeToLog(ByVal msg)
Set record = Installer.CreateRecord(1)
record.stringdata(0) = "AddExcelAddinStatus: [1]"
'This value gets subbed in to the [1] placeholder above
record.stringdata(1) = msg
record.formattext
message msiMessageTypeInfo, record
Set record = Nothing
End Sub

Step 4 – Create Custom Action to Uninstall Add-In

  • Now create another Type 38 CA. Call it ‘removeAddin’.
  • Schedule it straight after InstallInitialize and make it Deferred in a User Context (Setting it as deferred etc makes the Type become 1062 in your CA table).
    Give it a condition of:

REMOVE~=”ALL”

  • Paste the following code into your CA (You should only need to edit the value of blnDeleteFromAllProfiles. LEAVE EVERYTHING ELSE ALONE.):
'*************************************
'logic to uninstall addin (can be used for automation addins or COM addins)
'(All status messages are printed to installer log)
'(All log status entries start with 'RemoveExcelAddinStatus: {status}')
'*************************************
'set this to true/false depending on whether you want to attempt to delete the HKCU\xxxx\OPENx value from each user profile
'true = delete from all profiles false=delete from current profile only
Dim blnDeleteFromAllProfiles : blnDeleteFromAllProfiles = False
Dim blnReturn : blnReturn = False
Dim objXL
Dim objWorksheet
Dim objAddin
Dim strAddIn : strAddIn = ""
Dim strMsg : strMsg = ""
Dim strAddInName : strAddInName = ""
Dim addinList : addinList = ""
Dim addinListArray : addinListArray = ""
Dim i : i = 0
Const HKEY_CURRENT_USER = &H80000001
Const HKEY_LOCAL_MACHINE = &H80000002
Const HKEY_USERS = &H80000003
Dim tempRelativeId : tempRelativeId = 0
Dim strComputer : strComputer = "."
Dim strAddinKeyPath, strAddinValueName
Dim strValueName : strValueName = ""
Dim objRegistry, objFSO, objWshShell
'retrieve the value of the property we set earlier
'(The value is comma-separated in the form 'featureInstallState, Addin1, Addin2, Addin3......' etc)
addinList = Session.Property("CustomActionData")
'write value of Session Proeprty to log for debugging purposes
writeToLog("Deferred property contains: " & addinList)
If Len(addinList) > 0 Then 'if we found an add-In
addinListArray = split(addinList,",")
'for every addin passed in our property
For i = 0 To UBound(addinListArray)
strAddInName = addinListArray(i)
'we're uninstalling
blnReturn = RemoveExcelAddin(strAddInName)
If Not blnReturn Then
strMsg = "Unable to uninstall Excel add-in '" & strAddInName & "'"
writeToLog(strMsg)
Else
'now it's uninstalled we attempt to remove keys from add-in manager
'we do it here because it only gets generated after uninstall when our reference to Excel.Application is closed
Set objRegistry= GetObject("winmgmts:\\" & strComputer & "\root\default:StdRegProv")
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objWshShell = CreateObject("WScript.Shell")
'delete for current user
deleteFromProfile HKEY_CURRENT_USER,""
If blnDeleteFromAllProfiles Then
'try deleting key from all profiles
'profilelist reg key contains profiles which have logged on to the machine (and some default profiles too)
Dim strProfileListKeyPath
strProfileListKeyPath = "SOFTWARE\Microsoft\Windows NT\CurrentVersion\ProfileList"
objRegistry.EnumKey HKEY_LOCAL_MACHINE, strProfileListKeyPath, arrSubkeys
Dim arrSubkeys, objSubkey, strProfileValueName, strSubPath, ntuserfile, userfolder, officeversion, strOptionsKeyPath
Dim arrValueNames, arrValueTypes, strOptionsValueName, strValue, a
'enumerate all SIDs in profile list (profiles which have logged on to machine)
For Each objSubkey In arrSubkeys
tempRelativeId = Split(objSubkey,"-")
'check its not one of the default SIDs
If nonDefaultRelativeId(tempRelativeId(UBound(tempRelativeId))) Then
strProfileValueName = "ProfileImagePath"
strSubPath = strProfileListKeyPath & "\" & objSubkey
objRegistry.GetExpandedStringValue HKEY_LOCAL_MACHINE,strSubPath,strProfileValueName,userfolder
ntuserfile = userfolder & "\ntuser.dat"
'check the ntuser.dat file exists before we temporarily import it
If objFSO.fileExists(ntuserfile) Then
deleteFromProfile HKEY_USERS,ntuserfile
End If
End If
Next
Set objRegistry = Nothing
Set objFSO = Nothing
Set objWshShell = Nothing
End If
End If
Next
Else
strMsg = "No add-ins were found. If you are installing add-ins from a specific directory, check the case of your specified directory in the setAddinProperty CA."
writeToLog(strMsg)
End If
'*******************************************
'this function unloads and then deletes the add-in from the add-in manager.
'*******************************************
Function deleteFromProfile(HIVEKEY,ntuserfile)
On Error Resume Next
If Not ntuserfile = "" Then
objWshShell.Run "Reg.exe load HKEY_USERS\tempRegistry " & chr(34) & ntuserfile & chr(34), 0, True
strMsg = "Attempting to remove Add-in for ntuser file: " & ntuserfile
writeToLog(strMsg)
Else
strMsg = "Attempting to remove Add-in for current user"
writeToLog(strMsg)
End If
'unload and delete from add-in list for Office 97 to 2010
For officeversion = 8 to 14
strOpenKeyPath = "Software\Microsoft\Office\" & officeversion & ".0\Excel\Options"
strAddinKeyPath = "Software\Microsoft\Office\" & officeversion & ".0\Excel\Add-in Manager"
If Not ntuserfile = "" Then
strOpenKeyPath = "tempRegistry\" & strOpenKeyPath
strAddinKeyPath = "tempRegistry\" & strAddinKeyPath
End If
'unload from addin manager (delete OPENx value)
objRegistry.EnumValues HIVEKEY, strOpenKeyPath, arrValueNames, arrValueTypes
'check if a value is returned
If IsArray(arrValueNames) Then
'if so, loop through values in the registry key
For a=0 To UBound(arrValueNames)
strOpenValueName = arrValueNames(a)
'if the value starts with 'OPEN', then its an addin
If Left(UCase(strOpenValueName),4) = "OPEN" Then
objRegistry.GetStringValue HIVEKEY,strOpenKeyPath,strOpenValueName,strValue
'we check the OPEN value to see if it's our addin that we need to remove
If InStr(1,strValue,strAddInName,1) > 0 Then
strMsg = "Unloading: " & Replace(strOpenKeyPath,"tempRegistry\","") & "\" & strOpenValueName
writeToLog(strMsg)
'If it is, we delete it
objRegistry.DeleteValue HIVEKEY,strOpenKeyPath,strOpenValueName
If Err.Number <> 0 Then
strMsg = "Unloaded: " & strOpenKeyPath & "\" & strOpenValueName
writeToLog(strMsg)
Else
strMsg = "Could not unload: " & strOpenKeyPath & "\" & strOpenValueName
writeToLog(strMsg)
'reset error handling
On Error GoTo 0
End If
End If
End If
Next
End If
'delete from addin manager
objRegistry.EnumValues HIVEKEY, strAddinKeyPath, arrValueNames, arrValueTypes
'check if a value is returned
If isArray(arrValueNames) Then
'if so, loop through values in the registry key
For a=0 To UBound(arrValueNames)
strAddinValueName = arrValueNames(a)
'if the value name is the same as our addin
If InStr(1,strAddinValueName,strAddInName,1) > 0 Then
strMsg = "Deleting: " & Replace(strAddinKeyPath,"tempRegistry\","") & "\" & strAddinValueName
writeToLog(strMsg)
'If its the addin, we delete it
objRegistry.DeleteValue HIVEKEY,strAddinKeyPath,strAddinValueName
If Err.Number <> 0 Then
strMsg = "Deleted: " & strAddinKeyPath & "\" & strAddinValueName
writeToLog(strMsg)
Else
strMsg = "Could not delete: " & strAddinKeyPath & "\" & strAddinValueName
writeToLog(strMsg)
'reset error handling
On Error GoTo 0
End If
End If
Next
End If
Next
If Not ntuserfile = "" Then
objWshShell.Run "Reg.exe unload HKEY_USERS\tempRegistry", 0, True
End If
'reset error handling
On Error GoTo 0
End Function
'*******************************************
'Any group or user that is not created by default will have a Relative ID of 1000 or greater.
'The last hyphen-separated value in a SID is the relative id. This function omits these accordingly
'*******************************************
Function nonDefaultRelativeId(relativeId)
nonDefaultRelativeId = False
If IsNumeric(relativeId) Then
If relativeId >= 1000 Then
nonDefaultRelativeId = True
End If
End If
End Function
'*******************************************
'This function removes the Excel Addin
'*******************************************
Function RemoveExcelAddin(ByVal strAddIn)
Dim intCounter : intCounter = 0
Dim blnInstalled : blnInstalled = False
Dim addinName : addinName = Right(strAddIn,Len(strAddIn)-InStrRev(strAddIn,"\"))
RemoveExcelAddin = False
On Error Resume Next
Set objXL = CreateObject("Excel.Application")
If Err.Number <> 0 Then
strMsg = "Failed to create Excel object." & VbCrLf
strMsg = strMsg & "'" & strAddIn & "' was not installed."
writeToLog(strMsg)
Else
strMsg = "Created Excel object."
writeToLog(strMsg)
End If
'reset error handling
On Error GoTo 0
With objXL
For intCounter = 1 To .Addins.Count
If LCase(.Addins(intCounter).Name) = LCase(addinName) Then
If .Addins.Item(intCounter).Installed Then
blnInstalled = True
Exit For
End If
End If
Next
If blnInstalled Then
'intCounter ought still to be at the correct position,
'since we exited the For...Next loop when we located the add-in
.Addins.Item(intCounter).Installed = False
If Err.Number <> 0 Then
strMsg = ""
strMsg = strMsg & "Error: " & Err.Description & vbCRLF
strMsg = strMsg & "Failed to remove add-in '" & strAddIn & "'." & vbCRLF & "'" & strAddIn & "' was not removed."
writeToLog(strMsg)
'reset error handling
On Error GoTo 0
Else
strMsg = "Add-in '" & strAddIn & "' removed successfully."
blnInstalled = False
RemoveExcelAddin = True
writeToLog(strMsg)
End If
Else
strMsg = "Add-in '" & strAddIn & "' is not installed, so no removal necessary." & vbCRLF & "'" & strAddIn & "' was not removed."
writeToLog(strMsg)
'we return true so that the relevant OPENx keys are removed
RemoveExcelAddin = True
End If
End With
objXL.Quit
Set objAddin = Nothing
Set objXL = Nothing
End Function
Const msiMessageTypeInfo = &H04000000
'Subroutine to write to log file
Sub writeToLog(ByVal msg)
Set record = Installer.CreateRecord(1)
record.stringdata(0) = "RemoveExcelAddinStatus: [1]"
'This value gets subbed in to the [1] placeholder above
record.stringdata(1) = msg
record.formattext
message msiMessageTypeInfo, record
Set record = Nothing
End Sub