mbt masai
 
Welcome !
         

                                
After experiencing a lot of down time, We decided to move this site to CrystalTech.com. CrystalTech.com is powered by only the finest Windows servers providing the best performance, reliability, and value anywhere.

 Help trying to active Excel 2007 Add-ins

Author Message
Urban_Jungle

  • Total Posts : 4
  • Scores: 0
  • Reward points : 0
  • Joined: 3/25/2009
  • Status: offline
Help trying to active Excel 2007 Add-ins Monday, October 12, 2009 3:29 PM (permalink)
0
This one has got me stumped. (Mainly concerns Excel)

I am deploying Office 2007 and have customised it using OCT.

Whilst all add ins have been installed when you go into Excel Optins and addins they are inactive.

Has anyone been able to deploy Office 2007 with the add-ins active to the user does not have to go in and activate them?
 
I have found a script (I think written by VBScab from the appdeploy foruns) that sort of works but as I am not a Guru I am getting a bit lost. 
 
The thread there is http://www.appdeploy.com/messageboards/tm.asp?m=53585 
 
Basically the first addin works fine but the second one comes up as it is already installed.
 
eg strAddInPath works strAddInPath1 does not. The workbook and excel objects seem to be being created but when it tries to install the second add-in it says it is already installed. Also If I remove strAddInPath1 and strAddInName1 and run the script it works. Change those values to the ones for the second add-in it fails saying it is already installed.
 
Please note I am in no way proficient with vbscripting but can sort of understand what is going on.  Thanks in adavnced. If you can help me solve this it would be so much appreciated as my user base is starting to get very impatient.
 
strAddInPath                    = "C:\Program Files\Microsoft Office\Office12\Library\Analysis"
strAddInName                    = "ANALYS32.XLL"
strAddInPath1                    = "C:\Program Files\Microsoft Office\Office12\Library\Analysis"
strAddInName1                    = "ATPVBAEN.XLAM"
 
Anyway the script is.
 
 
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 strAddInPath1
Dim strAddInName1
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\Microsoft Office\Office12\Library\Analysis"
strAddInName                    = "ANALYS32.XLL"
strAddInPath1                    = "C:\Program Files\Microsoft Office\Office12\Library\Analysis"
strAddInName1                    = "ATPVBAEN.XLAM"
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
 
blnReturn                     = ExcelAddin(strAddInPath1, strAddInName1, 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
#1

    Online Bookmarks Sharing: Share/Bookmark

    Jump to:

    Current active users

    There are 0 members and 1 guests.

    Icon Legend and Permission

    • New Messages
    • No New Messages
    • Hot Topic w/ New Messages
    • Hot Topic w/o New Messages
    • Locked w/ New Messages
    • Locked w/o New Messages
    • Read Message
    • Post New Thread
    • Reply to message
    • Post New Poll
    • Submit Vote
    • Post reward post
    • Delete my own posts
    • Delete my own threads
    • Rate post

    2000-2012 ASPPlayground.NET Forum Version 3.8
    mbt shoes www.wileywilson.com