Software Deployment

No, no, no, NO! You should NOT use registry-writing to install Excel add-ins. This is because you have no way of knowing - without some excruciatingly-convoluted code - which 'OPENx' entry your add-in needs to use.

I suspect the reason why your installer doesn't work for 2007 is either that you have hard-coded entries for the Office version number (probably '10' for 2003, is it? 2007 is '12') and/or the registry location and/or key names have changed for 2007.

It's much simpler to use Excel Automation to handle add-ins. Here's some code which runs either stand-alone or as a Custom Action:Option Explicit

Dim strTempFile
Dim strTempFolder
Dim objSystemFolder
Dim strSystemFolder
Dim blnIsCustomAction
Dim blnReturn
Dim objXL
Dim objWorksheet
Dim objAddin
Dim strAddInPath
Dim strAddInName
Dim strAddIn
Dim strMsgNotInstalled
Dim strMsgNotRemoved

Dim objWSHShell
Dim objFSO
Dim strCmdLine
Dim strMsg
Dim objMSIRecord
Dim blnIsError
Dim blnIsDeferred
Dim strObjectType

Const intSystemFolder = 1
Const intTemporaryFolder = 2
Const intLogEventSuccess = 0
Const intLogEventError = 1
Const intLogEventWarning = 2
Const intLogEventInformation = 4
Const intLogEventAuditSuccess = 8
Const intLogEventAuditFailure = 16

Const intWindowHide = 0 '// Hides the window and activates another window.
Const intWindowActivateNormal = 1 '// Activates and displays a window.
'// If the window is minimized or maximized, the system restores it
'// to its original size and position. An application should specify
'// this flag when displaying the window for the first time.
Const intWindowActivateMinimised = 2 '// Activates the window and displays it as a minimized window.
Const intWindowActivateMaximised = 3 '// Activates the window and displays it as a maximized window.
Const intWindowMostRecent = 4 '// Displays a window in its most recent size and position.
'// The active window remains active.
Const intWindowActivateCurrent = 5 '// Activates the window and displays it in its current size and position.
Const intWindowHideMinimised = 6 '// Minimizes the specified window and activates the next top-level window
'// in the Z order.
Const intWindowMinimised = 7 '// Displays the window as a minimized window. The active window remains active.
Const intWindowCurrent = 8 '// Displays the window in its current state. The active window remains active.
Const intWindowActivateMostRecent = 9 '// Activates and displays the window. If the window is minimized or maximized,
'// the system restores it to its original size and position. An application
'// should specify this flag when restoring a minimized window.
Const intWindowUseParent = 10 '// Sets the show state based on the state of the program that started
'// the application.
Const blnWaitForCompletion = True '// Wait until the process has completed before handing back control


'// Change the target to be either a path, file or registry entry
'// Change the group name to be the application's group name (this is a fall-back only)
'// Change strPerm to suit your requirement (although 'full' for registry and 'change' for folder/file are fine)
strAddInPath = "C:\Program Files\AppsPro\ChartLabeler"
strAddInName = "XYChartLabeler.XLA"

blnIsCustomAction = False
blnIsDeferred = False

On Error Resume Next
If IsObject(Session) Then
'// We may have arrived here because error-trapping is off
If Err.Number = 0 Then
blnIsCustomAction = True
End If
End If

'// We test a well-known property and, if it returns an error, we MUST be in deferred mode, right?
If Len(Session.Property("UpgradeCode")) = 0 Then
blnIsDeferred = True
End If

On Error Goto 0

If blnIsCustomAction Then
If blnIsDeferred Then
strAddInPath = Split(Session.Property("CustomActionData"), ",")(0)
strAddIn = Split(Session.Property("CustomActionData"), ",")(1)
Else
strAddInPath = Session.Property("INSTALLDIR")
strAddInName = Session.Property("ADDINNAME")
End If
End If

Set objWSHShell = CreateObject("Wscript.Shell")
Set objFSO = CreateObject("Scripting.FileSystemObject")

blnReturn = ExcelAddin(strAddInPath, strAddInName, True) '// Pass 'True' to install, 'False' to uninstall
If Not blnReturn Then
blnIsError = True
strMsg = "Unable to install Excel add-in."

Call Say(strMsg, blnIsError, blnIsCustomAction)
End If

Set objFSO = Nothing
Set objWSHShell = Nothing

Function ExcelAddin(ByVal strPath, ByVal strName, blnInstalling)
'// For adding, place under Install Execute Sequence
'// Location: After InstallFinalize
'// Condition: 'NOT REMOVE' or 'NOT Installed'
'// Properties: Immediate Execution; Synchronous; Always Execute

'// For removing, place under Install Execute Sequence
'// Location: After InstallInitialize
'// Condition: 'REMOVE' or 'REMOVE~="ALL"'
'// Properties: Immediate Execution; Synchronous; Always Execute

Dim objFSO_XL
Dim intCounter
Dim blnInstalledAlready

ExcelAddin = False
blnInstalledAlready = False

strAddIn = strPath & "\" + strName

strMsgNotInstalled = "'" & strAddIn & "' was not installed."
strMsgNotRemoved = "'" & strAddIn & "' was not removed."

If blnInstalling Then
'// We only care about this if we're installing
Set objFSO_XL = CreateObject("Scripting.FileSystemObject")

With objFSO_XL
strMsg = ""
On Error Resume Next
'// Check source path exists
If Not .FolderExists(strPath) Then
strMsg = "The add-in source folder " & strPath & " does not exist." & vbCRLF & strMsgNotInstalled
blnIsError = True
Call Say(strMsg, blnIsError, blnIsCustomAction)
Exit Function
End If

'// Check source file exists
If Not .FileExists(strAddIn) Then
strMsg = "The source file " & strAddIn & " does not exist." & vbCRLF & strMsgNotInstalled
blnIsError = True
Call Say(strMsg, blnIsError, blnIsCustomAction)
Exit Function
End If

On Error Goto 0
End With
End If

On Error Resume Next
Set objXL = CreateObject("Excel.Application")
If Err.Number <> 0 Then
blnIsError = True
strMsg = "Failed to create Excel object." & vbCRLF
If blnInstalling Then
strMsg = strMsg & strMsgNotInstalled
Else
strMsg = strMsg & strMsgNotRemoved
End If
Call Say(strMsg, blnIsError, blnIsCustomAction)
Else
blnIsError = False
strMsg = "Created Excel object." & vbCRLF
Call Say(strMsg, blnIsError, blnIsCustomAction)
End If

If blnInstalling Then
'// We only need this if we're installing
Set objWorksheet = objXL.Workbooks.Add()
If Err.Number <> 0 Then
blnIsError = True
strMsg = "Failed to create new workbook." & vbCRLF
If blnInstalling Then
strMsg = strMsg & strMsgNotInstalled
Else
strMsg = strMsg & strMsgNotRemoved
End If
Call Say(strMsg, blnIsError, blnIsCustomAction)
Else
blnIsError = False
strMsg = "Created worksheet object." & vbCRLF
Call Say(strMsg, blnIsError, blnIsCustomAction)
End If
End If

With objXL
For intCounter = 1 to .Addins.Count
If .Addins.Item(intCounter).Installed Then
blnInstalledAlready = True
Exit For
End If
Next

If blnInstalling Then
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 & strMsgNotInstalled
blnIsError = True
Call Say(strMsg, blnIsError, blnIsCustomAction)
Else
blnIsError = False
strMsg = "Add-in '" & strAddIn & "' installed successfully." & vbCRLF
Call Say(strMsg, blnIsError, blnIsCustomAction)
blnInstalledAlready = True
objAddin.Installed = True
End If
Else
strMsg = "Add-in '" & strAddIn & "' is already installed." & vbCRLF & strMsgNotInstalled
blnIsError = False
Call Say(strMsg, blnIsError, blnIsCustomAction)
End If
Else
If blnInstalledAlready 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 & strMsgNotRemoved
blnIsError = True
Call Say(strMsg, blnIsError, blnIsCustomAction)
Else
strMsg = "Add-in '" & strAddIn & "' removed successfully." & vbCRLF
blnIsError = False
Call Say(strMsg, blnIsError, blnIsCustomAction)
blnInstalledAlready = False
objAddin.Installed = False
End If
Else
strMsg = "Add-in '" & strAddIn & "' is not installed, so no removal necessary." & vbCRLF & strMsgNotRemoved
blnIsError = False
Call Say(strMsg, blnIsError, blnIsCustomAction)
End If
End If
End With

If blnInstalling Then
If blnInstalledAlready Then
'// We test blnInstalledAlready because objAddIn.Installed may not be set if the installation failed
ExcelAddin = True
End If
Else
If Not blnInstalledAlready Then
'// We test blnInstalledAlready because objAddIn.Installed may not be set if the installation failed
ExcelAddin = True
End If
End If

objXL.Quit

On Error Goto 0

Set objFSO_XL = Nothing
Set objAddin = Nothing
Set objXL = Nothing
End Function

Sub Say(ByVal strMsgText, ByVal blnError, ByVal blnCustomAction)
Dim intMSILogMsgType
Dim intEventLogMsgType
Dim objMSIRecord

Const msiMessageTypeFatalExit = &H00000000 '// Premature termination, possibly fatal out of memory.
Const msiMessageTypeError = &H01000000 '// Formatted error message, [1] is message number in Error table.
Const msiMessageTypeWarning = &H02000000 '// Formatted warning message, [1] is message number in Error table.
Const msiMessageTypeUser = &H03000000 '// User request message, [1] is message number in Error table.
Const msiMessageTypeInfo = &H04000000 '// Informative message for log, not to be displayed.
Const msiMessageTypeFilesInUse = &H05000000 '// List of files in use that need to be replaced.
Const msiMessageTypeResolveSource = &H06000000 '// Request to determine a valid source location.
Const msiMessageTypeOutOfDiskSpace = &H07000000 '// Insufficient disk space message.
Const msiMessageTypeActionStart = &H08000000 '// Start of action,
'// [1] action name,
'// [2] description,
'// [3] template for ACTIONDATA messages.
Const msiMessageTypeActionData = &H09000000 '// Action data. Record fields correspond to the template of ACTIONSTART message.
Const msiMessageTypeProgress = &H0A000000 '// Progress bar information. See the description of record fields below.
Const msiMessageTypeCommonData = &H0B000000 '// To enable the Cancel button set [1] to 2 and [2] to 1.
'// To disable the Cancel button set [1] to 2 and [2] to 0

If blnError Then
intMSILogMsgType = msiMessageTypeError
intEventLogMsgType = intLogEventError
Else
intMSILogMsgType = msiMessageTypeInfo
intEventLogMsgType = intLogEventSuccess
End If

If blnCustomAction Then
Set objMSIRecord = Session.Installer.CreateRecord(0)
objMSIRecord.StringData(0) = strMsgText
Session.Message intMSILogMsgType, objMSIRecord
Set objMSIRecord = Nothing
Else
'// Make an entry in Event Log
objWSHShell.LogEvent intEventLogMsgType, strMsgText

WScript.Echo strMsgText
End If
End Sub

Sub Sleep(ByVal intSleepPeriod)
'// Timer returns the number of seconds that have elapsed since midnight.

Dim intStartTime
Dim intEndTime
Dim intCurrentTime

On Error Resume Next

intStartTime = Timer
intEndTime = intStartTime + intSleepPeriod

Do While Timer <= intEndTime
Loop

On Error Goto 0

End Sub

Function DoesRegistryKeyExist(ByVal strRegistryKey)
Dim strErrDescription

Const strDummyKey = "HKEY_ERROR\"

'// Ensure the last character is a backslash (\). If it isn't, we aren't looking for a key
If (Right(strRegistryKey, 1) <> "\") Then
'// It's not a registry key we are looking for
DoesRegistryKeyExist = False
Else
'// If there isnt the key when we read it, it will return an error, so we need to resume
On Error Resume Next

'// Try reading the key
objWSHShell.RegRead strRegistryKey

'Catch the error
Select Case Err
Case 0
'// Error Code 0 = 'success'
DoesRegistryKeyExist = True
Case &h80070002
'// This checks for the (Default) value existing (but being blank); as well as key's not existing at all (same error code)
'// Read the error description, removing the registry key from that description
strErrDescription = Replace(Err.Description, strRegistryKey, "")

'// Clear the error
Err.Clear

'// Read in a registry entry we know doesn't exist (to create an error description for something that doesn't exist)
objWSHShell.RegRead strDummyKey

'// The registry key exists if the error description from the HKEY_ERROR RegRead attempt doesn't match the error
'// description from our strRegistryKey RegRead attempt
If (strErrDescription<> Replace(Err.Description, strDummyKey, "")) Then
DoesRegistryKeyExist = True
Else
DoesRegistryKeyExist = False
End If
Case Else
'// Any other error code is a failure code
DoesRegistryKeyExist = False
End Select

'// Turn error reporting back on
On Error Goto 0
End If
End Function

Function ExtractBinary(ByVal strBinaryName, ByVal strOutputFile)
Dim objDatabase
Dim objView
Dim objRecord
Dim objBinaryData
Dim objStream

Const msiReadStreamAnsi = 2

ExtractBinary = False

Set objDatabase = Session.Database

Set objView = objDatabase.OpenView("SELECT * FROM Binary WHERE Name = '" & strBinaryName & "'")
objView.Execute

Set objRecord = objView.Fetch

objBinaryData = objRecord.ReadStream(2, objRecord.DataSize(2), msiReadStreamAnsi)

Set objStream = objFSO.CreateTextFile(strOutputFile, True)
objStream.Write objBinaryData
objStream.Close

If objFSO.FileExists(strOutputFile) Then
ExtractBinary = True
End If

Set objStream = Nothing
Set objRecord = Nothing
Set objView = Nothing
Set objDatabase = Nothing

End Function

Function CreateTempFile()
Dim objTempFolder
Dim strTempFileName

With objFSO
Set objTempFolder = .GetSpecialFolder(intTemporaryFolder)
strTempFolder = objTempFolder.Path
strTempFileName = .GetTempName
End With

CreateTempFile = objTempFolder.Path & "\" & strTempFileName
End Function

Function DeleteFile(ByVal strFile)

DeleteFile = False
On Error Resume Next

With objFSO
.DeleteFile strFile, True
If Not .FileExists(strFile) Then
DeleteFile = True
End If
End With
End Function