excel - Programmatically Install Add-In VBA

Question

I'm looking to create a macro that'll install an add-in for the user to the excel ribbon. I'm upto:

Private Sub Workbook_Open()

On Error Resume Next
Application.AddIns("Name of Addin").Installed = False
On Error GoTo 0

With Application
    .AddIns.Add "Filepath to addin in shared location", False
    .AddIns("Name of Addin").Installed = True
End With

ThisWorkbook.Close False

End Sub

Once running the macro, the addin installs to the ribbon no problems. The issue is, once excel is closed down, the addin no longer shows in the ribbon.

It would appear that excel is expecting the addin to be copied into the users C:Documents and SettingsUsernameApplication DataMicrosoftAddiIns folder as it throws the error that it can't find it when starting excel after closing down.

Now my understanding is that the second (false) variable for the line of code below basically says that the addin shouldn't be copied to the AddIns directory and rather should stay in the shared location.

.AddIns.Add "Filepath to addin in shared location", False

Any ideas on why Excel is expecting the addin to be in the users default folder?

Answer 1

I'll give it a try. Please see comments in code.

ThisWorkbook

Option Explicit
 '
 '---------------------------------------------------------------------
 ' Purpose : Call for installation as an addin if not installed
 '---------------------------------------------------------------------
 '
Private Sub Workbook_Open()

    Dim AddinTitle As String, AddinName As String
    Dim XlsName As String

    AddinTitle = Left(ThisWorkbook.Name, Len(ThisWorkbook.Name) - 4)
    XlsName = AddinTitle & ".xlsm"
    AddinName = AddinTitle & ".xla"

     'check the addin's not already installed in UserLibraryPath
    If Dir(Application.UserLibraryPath & AddinName) = Empty Then
         'ask if user wants to install now
        If MsgBox("Install " & AddinTitle & _
        " as an add-in?", vbYesNo, _
        "Install?") = vbYes _
        Then
            Run "InstallAddIn"
        End If
    Else
        If ThisWorkbook.Name = XlsName Then
            Run "ReInstall"
        End If
    End If

End Sub

 '
 '---------------------------------------------------------------------
 ' Purpose : Actuate the addin, add custom controls
 '---------------------------------------------------------------------
 '
Private Sub Workbook_AddinInstall()
    Run "AddButtons"
End Sub
 '
 '---------------------------------------------------------------------
 ' Purpose : Deactivate the addin, remove custom controls
 '---------------------------------------------------------------------
 '
Private Sub Workbook_AddinUninstall()
    Run "RemoveButtons"
End Sub

Module

Option Explicit
 '
 '---------------------------------------------------------------------
 ' Purpose : Convert .xls file to .xla, move it to
 ' addins folder, and install as addin
 '---------------------------------------------------------------------
 '
Private Sub InstallAddIn()

    Dim AddinTitle As String, AddinName As String
    Dim XlsVersion As String, MessageBody As String

    With ThisWorkbook
        AddinTitle = Left(.Name, Len(.Name) - 4)
        AddinName = AddinTitle & ".xlam"
        XlsVersion = .FullName '< could be anywhere

         'check the addin's not installed in
         'UserLibraryPath (error handling)
        If Dir(Application.UserLibraryPath & AddinName) = Empty Then

            .IsAddin = True '< hide workbook window

             'move & save as .xla file
            .SaveAs Application.UserLibraryPath & AddinName, 55

             'go thru the add-ins collection to see if it's listed
            If Listed Then
                 'check this addins checkbox in the addin dialog box
                AddIns(AddinTitle).Installed = True '<--Error happening if .xlam format
            Else
                 'it's not listed (not previously installed)
                 'add it to the addins collection
                 'and check this addins checkbox
                AddIns.Add(ThisWorkbook.FullName, True) _
                .Installed = True
            End If

             'inform user...
            MessageBody = AddinTitle & " has been installed - " & _
            "to access the tools available in" & _
            vbNewLine & _
            "this addin, you will find a button in the 'Tools' " & _
            "menu for your use"
            If BooksAreOpen Then '< quit if no other books are open
                .Save
                MsgBox MessageBody & "...", , AddinTitle & _
                " Installation Status..."
            Else
                If MsgBox(MessageBody & " the" & vbNewLine & _
                "next time you open Excel." & _
                "" & vbNewLine & vbNewLine & _
                "Quit Excel?...", vbYesNo, _
                AddinTitle & " Installation Status...") = vbYes Then
                    Application.Quit
                Else
                    .Save
                End If
            End If
        End If

    End With
End Sub


'---------------------------------------------------------------------
 ' Purpose : Checks if this addin is in the addin collection
 '---------------------------------------------------------------------
 '
Private Function Listed() As Boolean

    Dim Addin As Addin, AddinTitle As String

    Listed = False
    With ThisWorkbook
        AddinTitle = Left(.Name, Len(.Name) - 4)
        For Each Addin In AddIns
            If Addin.Title = AddinTitle Then
                Listed = True
                Exit For
            End If
        Next
    End With
End Function


'---------------------------------------------------------------------
 ' Purpose : Check if any workbooks are open
 ' (this workbook & startups excepted)
 '---------------------------------------------------------------------
 '
Private Function BooksAreOpen() As Boolean
     '
    Dim Wb As Workbook, OpenBooks As String

     'get a list of open books
    For Each Wb In Workbooks
        With Wb
            If Not (.Name = ThisWorkbook.Name _
            Or .Path = Application.StartupPath) Then
                OpenBooks = OpenBooks & .Name
            End If
        End With
    Next
    If OpenBooks = Empty Then
        BooksAreOpen = False
    Else
        BooksAreOpen = True
    End If
End Function


'---------------------------------------------------------------------
 ' Purpose : Replace addin with another version if installed
 '---------------------------------------------------------------------
 '
Private Sub ReInstall()

    Dim AddinName As String

    With ThisWorkbook
        AddinName = Left(.Name, Len(.Name) - 4) & ".xla"

         'check if 'addin' is already installed
         'in UserLibraryPath (error handling)
        If Dir(Application.UserLibraryPath & AddinName) = Empty Then

             'install if no previous version exists
            Call InstallAddIn

        Else
             'delete installed version & replace with this one if ok
            If MsgBox(" The target folder already contains " & _
            "a file with the same name... " & _
            vbNewLine & vbNewLine & _
            " (That file was last modified on: " & _
            Workbooks(AddinName) _
            .BuiltinDocumentProperties("Last Save Time") & ")" & _
            vbNewLine & vbNewLine & vbNewLine & _
            " Would you like to replace the existing file with " & _
            "this one? " & _
            vbNewLine & vbNewLine & _
            " (This file was last modified on: " & _
            .BuiltinDocumentProperties("Last Save Time") & ")", _
            vbYesNo, "Add-in Is In Place - " & _
            "Confirm File Replacemant...") = vbYes Then
                Workbooks(AddinName).Close False
                Kill Application.UserLibraryPath & AddinName
                Call InstallAddIn
            End If
        End If
    End With
End Sub

 '---------------------------------------------------------------------
 ' Purpose : Convert .xla file to .xls format
 ' and move it to default file path
 '---------------------------------------------------------------------
 '
Private Sub RemoveAddIn()

    Dim AddinTitle As String, AddinName As String
    Dim XlaVersion As String

    Application.ScreenUpdating = False

    With ThisWorkbook
        AddinTitle = Left(.Name, Len(.Name) - 4)
        AddinName = AddinTitle & ".xla"
        XlaVersion = .FullName

         'check the 'addin' is not already removed
         'from UserLibraryPath (error handling)
        If Not Dir(Application.UserLibraryPath & AddinName) = Empty _
        Then

            .Sheets(1).Cells.ClearContents '< cleanup
            Call RemoveButtons

             'move & save as .xls file
            .SaveAs Application.DefaultFilePath & _
            "" & AddinTitle & ".xls"

            Kill XlaVersion '< delete .xla version

             'uncheck checkbox in the addin dialog box
            AddIns(AddinTitle).Installed = False
            .IsAddin = False '< show workbook window
            .Save

             'inform user and close
            MsgBox "The addin '" & AddinTitle & "' has been " & _
            "removed and converted to an .xls file." & _
            vbNewLine & vbNewLine & _
            "Should you later wish to re-install this as " & _
            "an addin, open the .xls file which" & _
            vbNewLine & "can now be found in " & _
            Application.DefaultFilePath & _
            " as: '" & .Name & "'"
            .Close
        End If

    End With

    Application.ScreenUpdating = True
End Sub


'---------------------------------------------------------------------
 ' Purpose : Add addin control buttons
 '---------------------------------------------------------------------
 '
Private Sub AddButtons()

     'change 'Startups...' to suit
    Const MyControl As String = "Startups..."
     'change 'Manage Startups' to suit
    Const MyControlCaption As String = "Manage Startups"

    Dim AddinTitle As String, Mybar As Object

    AddinTitle = Left(ThisWorkbook.Name, Len(ThisWorkbook.Name) - 4)

    Call RemoveButtons

    On Error GoTo ErrHandler
    Set Mybar = Application.CommandBars("Worksheet Menu Bar") _
    .Controls("Tools").Controls _
    .Add(Type:=msoControlPopup, before:=13)
     '
    With Mybar
        .BeginGroup = True
        .Caption = MyControl
         '-------------------------------------------------------------
        .Controls.Add.Caption = MyControlCaption
        .Controls(MyControlCaption).OnAction = "ShowStartupForm"
         '-------------------------------------------------------------
        With .Controls.Add
            .BeginGroup = True
            .Caption = "Case " & AddinTitle
        End With
        .Controls("Case change " & AddinTitle).OnAction = "ULCase.UpperMacro"
         '-------------------------------------------------------------
        .Controls.Add.Caption = "Remove " & AddinTitle
        .Controls("Remove " & AddinTitle).OnAction = "Module1.RemoveAddIn"
         '-------------------------------------------------------------
    End With
    Exit Sub

ErrHandler:
    Set Mybar = Nothing
    Set Mybar = Application.CommandBars("Tools") _
    .Controls.Add(Type:=msoControlPopup, before:=13)
    Resume Next
End Sub
 '
 '---------------------------------------------------------------------
 ' Purpose : Remove addin control buttons
 '---------------------------------------------------------------------
 '
Private Sub RemoveButtons()
     '
     'change 'Startups...' to suit
    Const MyControl As String = "Startups..."
    On Error Resume Next
    With Application
        .CommandBars("Tools").Controls(MyControl).Delete
        .CommandBars("Worksheet Menu Bar") _
        .Controls("Tools").Controls(MyControl).Delete
    End With
End Sub