6

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 Settings\Username\Application Data\Microsoft\AddiIns 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?

4
  • 1
    It is not necessary that you have to copy the Add-In to the specific Add-In folder but yes, it needs to reside on your hard drive. I guess Shared Drive is considered as "Removalble Drive" as it can be disconnected anytime. Form Excel's Help file Ignored if the add-in file is on a hard disk. True to copy the add-in to your hard disk, if the add-in is on a removable medium (a floppy disk or compact disc). False to have the add-in remain on the removable medium. If this argument is omitted, Microsoft Excel displays a dialog box and asks you to choose. Commented Jan 25, 2014 at 16:34
  • 1
    @SiddharthRout Thanks for your comment, I've got a previous xla addin that I keep stored on the shared drive which stays loaded after excel is closed. I'm thinking one solution could be to build another addin that can reside on the local machines hard drive and then load the shared addin when excel starts. The addin needs to remain in a shared location for maintenance purposes. Cheers Commented Jan 25, 2014 at 17:40
  • 3
    ` I've got a previous xla addin that I keep stored on the shared drive which stays loaded after excel is closed.` In that case, check if there is any code which is unloading the add-in when the workbook closes. check in both (above workbook and in the add-n) Commented Jan 25, 2014 at 20:39
  • 1
    The problem may also be that the add-in workbook is blocked in Windows, as I describe for a specific add-in here: Add-In Disappears from Excel. Commented Jan 6, 2022 at 18:38

2 Answers 2

4

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
Sign up to request clarification or add additional context in comments.

5 Comments

Beautiful code! Pity that the questioner does not react. However, since the question is from 2014, he/she may not have seen this.
I wonder why you are using the expression Left(ThisWorkbook.Name, Len(ThisWorkbook.Name) - 4) to catch the base name of the workbook. That seems unsafe to me because there can be suffixes of varying length (not always 4 chars). I am only asking this because your code looks very elaborated to me, except for this expression.
AddinTitle = Left(.Name, Len(.Name) - 4) .Name: Refers to the name of ThisWorkbook (the current workbook's name). Len(.Name): Calculates the length (number of characters) of the workbook's name. Left(.Name, Len(.Name) - 4): Takes the leftmost characters of the workbook's name, excluding the last four characters. What it does: This line removes the last four characters from the workbook's name (typically ".xlsm" for a macro-enabled workbook), resulting in the base name without the file extension. Example: If the workbook's name is "MyWorkbook.xlsm", AddinTitle will be "MyWorkbook".
Yes, but ".xlsm" is five characters. So, the expression will leave the dot there. For an Excel file with ".xls", it will remove the dot. Anyway, I saw that this has already been discussed in the comments of other postings from you. I prefer to use the FileSystemObject function "GetBaseName" to get rid of the extension. However, I see that this is a matter of personal preference, as some programmers try to avoid referencing the Scripting library.
I think it was just an example I used but Its too long ago I think the adin extension is .xla which will be 4 char. This is the code I used back then and it worked for me so not sure if things have changed in the past years as I never touched VBA in a while now so will need to look it up and see. If that is the case you can run it in debug and see how many char it returns and then increase it to 5 if it's not working anymore. But as you said to each is own.
0

I spend an afternoon debugging this code.

There is a subtle confusion inside this code : This code take a shortcut when it derived AddIn Title from current Filename. But Excel seems to use the file 'Title" property as AddIn Title, once installed.

This code was write before Office starts using Ribbon. So the Menu and button setup code are useless

Found here, the fix for one error :

        ' https://stackoverflow.com/questions/55054979/constantly-getting-err-1004-when-trying-to-using-application-addins-add
        If Application.Workbooks.Count = 0 Then Set wb = Application.Workbooks.Add()

        ' it's not listed (not previously installed)
        ' add it to the addins collection
        ' and check this addins checkbox
        Application.AddIns.Add Filename:=Application.UserLibraryPath & AddinName  ' ThisWorkbook.FullName, CopyFile:=True

This don't work :

 Workbooks(AddinName) _
            .BuiltinDocumentProperties("Last Save Time")

In a nutshell, be careful, there is a lot of debugging to make this code fully functional.

Comments

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Start asking to get answers

Find the answer to your question by asking.

Ask question

Explore related questions

See similar questions with these tags.