How to get VBA excel addin .xlam to replace itself by a remote updated .xlam?

Question

I need some way to update an excel addin shared among my staffs so as everyone don't have to download & install it manually.

I have googled and see that we can write file to the OS file system so the task ends up with writing the new-version addin, i.e. the .xlam file, to overwrite itself.

I have no idea on how to do this. If you do have ones, please share! Thank you!

Answer 1

I don't know if there's a less crude way of doing it, but I have "hacked" a solution that involves SendKeys. Yuck, I know. Hopefully someone else will have a better solution.

As I recall, you need to uninstall an addin before you can overwrite the .xla(m) file and I couldn't find a way to do this purely using built-in objects.

The code below basically uninstalls the add-in, invokes the "Add-ins" dialog box and uses SendKeys to remove it from the list, before copying the new file and reinstalling the add-in.

Amend it for your circumstances - it will depend on your users having their security settings low enough to let it run, of course.

Sub UpdateAddIn()          
    Dim fs As Object
    Dim Profile As String

    If Workbooks.Count = 0 Then Workbooks.Add
    Profile = Environ("userprofile")
    Set fs = CreateObject("Scripting.FileSystemObject")
    AddIns("MyAddIn").Installed = False
    Call ClearAddinList
    fs.CopyFile "\\SourceOfLatestAddIn\MyAddIn.xla", Profile & "\Application Data\Microsoft\AddIns\", True
    AddIns.Add Profile & "\Application Data\Microsoft\AddIns\MyAddIn.xla"
    AddIns("MyAddIn").Installed = True
End Sub

Sub ClearAddinList()        
    Dim MyCount As Long
    Dim GoUpandDown As String

    'Turn display alerts off so user is not prompted to remove Addin from list
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False

    Do
        'Get Count of all AddIns
        MyCount = Application.AddIns.Count    

        'Create string for SendKeys that will move up & down AddIn Manager List
        'Any invalid AddIn listed will be removed
        GoUpandDown = "{Up " & MyCount & "}{DOWN " & MyCount & "}"    
        Application.SendKeys GoUpandDown & "~", False
        Application.Dialogs(xlDialogAddinManager).Show    
    Loop While MyCount <> Application.AddIns.Count    

    Application.DisplayAlerts = True
    Application.ScreenUpdating = True    
End Sub

Answer 2

I use a reversioning addin-manager to do this: basically its a small xla/xlam that never changes thats installed on each users machine. It checks a network share for the latest version of the real addin(s) and opens it as if it was an ordinary workbook: this has the effect of loading the real Addin(s) for the user.

There is a downloadable working example which you can customise here

Answer 3

Another option, this is what I do.

Key points. Addin version is "some number", file name is always the same. Installation directory must be known

When asked, the current addin, looks to see if a new version is available. I do this via a system that has a version number in the file name of the "update" and a version number as a const in the code.

Having established I we can update, I go and get the update "package" - in my case I am using an installer and a small vb.net app. If you cant do this then you might want to spin up an insatnce of PPT or word, and use that complete the install.

Next close yourself, or ask the user to close Excel.

Now all we need to do is save the new addin over the old one, with the same file name.

Tell the user its updated, and they should re-open Excel, close the install program.

This works well for me - although you need to remember the numbering system , in the file name and how that code works.

The below is the main guts of the code bit messy, but might help you out.

Private Sub CommandButton1_Click()
    Dim RetVal As Long
    MsgBox "To install the update, follow the installer programes directions." & vbNewLine & vbNewLine & _
           "You will need to then closed down and restart Excel.", vbInformation + vbOKOnly, "::::UPDATE TRS:::::"
    RetVal = Shell(gsDataBase1 & "\" & gsUpdatefolder & "\" & GetUpdateFileName(), 1)
    ThisWorkbook.Close
    Unload Me
End Sub

Private Sub CommandButton2_Click()
    gbInUpdate = False
    Unload Me
End Sub

Private Sub UserForm_Initialize()
    Me.lbNew = GetServerVersion2
    Me.lbCurrent.Caption = gcVersionNumber
    'CheckVersionNumbers
End Sub

'''This method might be better, but is quite slow.
Public Sub GetServerVersion()
    Set objshell = CreateObject("Shell.Application")
    Set objFolder = objshell.Namespace(gsDataBase1 & "\" & gsUpdatefolder)
    For Each strFileName In objFolder.Items
        Me.lbNew.Caption = objFolder.GetDetailsOf(strFileName, 11)
    Next
    Set objshell = Nothing
End Sub

Public Function IsNewer() As Boolean
    Dim curVer As Long
    Dim newVer As Long
    On Error GoTo Catch
    curVer = CLng(Left(Replace(Me.lbCurrent, ".", ""), 2))
    newVer = CLng(Left(Replace(Me.lbNew, ".", ""), 2))
    If curVer < newVer Then
        IsNewer = True
    Else
        IsNewer = False
    End If
    Exit Function
Catch:
    IsNewer = False
End Function

Private Function GetServerVersion2() As String
    On Error GoTo LEH
    Dim strDocPath As String
    Dim strCurrentFile As String
    strDocPath = gsDataBase1 & "\" & gsUpdatefolder & "\"
    strCurrentFile = Dir(strDocPath & "*.*")
    'gets last file - randomly? should onl;y be one anyway!
    'Do While strCurrentFile <> ""
    GetServerVersion2 = Right(strCurrentFile, 11)
    GetServerVersion2 = Left(GetServerVersion2, 7)
    'Loop
    Exit Function
LEH:
    GetServerVersion2 = "0.Error"
End Function

'Basiclly a coop of GetSeverVerion, but just get the file name so the exe can be called by the shell operation under the update button
''seems clumbys, but works!
Private Function GetUpdateFileName() As String
    On Error GoTo LEH
    Dim strDocPath As String
    Dim strCurrentFile As String
    strDocPath = gsDataBase1 & "\" & gsUpdatefolder & "\"
    GetUpdateFileName = Dir(strDocPath & "*.*")
    Exit Function
LEH:
    GetUpdateFileName = "0.Error"
End Function