Hello All,

I would like to create code for add-ins to simplify the installation process for end users.

All the end user needs to do/know is double click on the XLM/XLAM in their Windows folder . It will then silently copy itself to a target location, install in add-ins library and auto open. (For the point of this exercise, assume that end users already have macro security set to allow all macros and/or I have already explained that they need to enable macros after double-clicking/opening the excel file)

I was thinking of code called at workbook_open that would check if the add-in is already installed and in the target location (I prefer the Application.UserLibraryPath). Otherwise, it will save a copy of the workbook in the target location, install the copy from the target location and then close ThisWorkbook (to prevent two copies of the same add-in open).

This is what I have so far (code below). However I am currently getting an error message "out of stack space" in the macro "AddIn_Open" on the line "ThisWorkbook.SaveCopyAs". Why?

CODE #1 (goes in ThisWorkbook module)
Option Explicit

Private Sub Workbook_Open()
    If ThisWorkbook.IsAddin Then
        Call AddIn_Open
        Exit Sub
    End If
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    If ThisWorkbook.IsAddin Then
        Call AddIn_BeforeClose
        Exit Sub
    End If
End Sub
CODE 2 (paste into a standard module)
Option Explicit
Option Private Module

Public Sub AddIn_Open()
'   ensure AddIn is installed
    If AddIn_EnsureInstalledCorrectly = False Then
        'Copy workbook to library path and install it
        Application.EnableEvents = False
        ThisWorkbook.SaveCopyAs Application.UserLibraryPath & ThisWorkbook.Name
        Application.EnableEvents = True
        Call InstallAddIn(Application.UserLibraryPath, ThisWorkbook.Name)
        ThisWorkbook.Close (False)
        Exit Sub
    End If

    Call CreateControls
End Sub

Public Sub AddIn_BeforeClose()
    'If ThisWB was not in the user library path close (due to AddIn_EnsureInstalledCorrectly code so as not to call DeleteControls)
    If Not RemoveFilePathFromString(ThisWorkbook.FullName) = Application.UserLibraryPath Then Exit Sub

    Call DeleteControls
End Sub

Public Sub InstallAddIn(sFilePath As String, sAddInName As String)
'   First check if XLAM exists in file location
    If Exists_FileFolder(sFilePath & sAddInName) = False Then Exit Sub

'   next check if any workbook visible in Excel and open if not (This is necessary to avoid the error on installing XLAMs)
    If Count_VisibleWorkbooks = 0 Then
        Application.ScreenUpdating = False
        Workbooks.Add
        Dim TmpWB As Workbook
        Set TmpWB = ActiveWorkbook
        ActiveWorkbook.EnableAutoRecover = False
    End If

'   http://www.cpearson.com/excel/installinganxla.aspx
    Dim ai As Excel.AddIn
    Set ai = Application.AddIns.Add(FileName:=sFilePath & sAddInName)
    ai.Installed = False
    ai.Installed = True

'   close temp workbook (if one created previously)
    On Error Resume Next
    TmpWB.Close False
    On Error GoTo 0
End Sub

Public Function Count_VisibleWorkbooks() As Byte
    Dim Wb As Workbook
    For Each Wb In Workbooks
        If Wb.Windows(1).Visible Then Count_VisibleWorkbooks = Count_VisibleWorkbooks + 1
    Next
End Function
'
'--------public above, private below------------------------------
'
Private Function AddIn_EnsureInstalledCorrectly() As Boolean
'adapted from code by John Walkenbach
    AddIn_EnsureInstalledCorrectly = True

    Dim ai As AddIn
    Dim TWB_FileName As String
    TWB_FileName = ThisWorkbook.Name
    'Is it in the AddIns collectin?
    Application.ScreenUpdating = False
    For Each ai In AddIns
        If ai.Name = TWB_FileName Then
            If ai.Installed Then Exit Function
        End If
    Next ai

    If Application.UserLibraryPath = RemoveFileNameFromString(ThisWorkbook.FullName) Then Exit Function

    AddIn_EnsureInstalledCorrectly = False
End Function
CODE 3 I am using some functions in other modules. Just copy below into a module in the same project.
Public Function RemoveFileExtFromString(FileName As String) As String
    RemoveFileExtFromString = Left(FileName, (InStrRev(FileName, ".", -1, vbTextCompare) - 1))
End Function

Public Function RemoveFileNameFromString(FileName As String) As String
    RemoveFileNameFromString = Left(FileName, InStrRev(FileName, "\"))
End Function

Public Function RemoveFilePathFromString(FileName As String) As String
    RemoveFilePathFromString = Mid(FileName, InStrRev(FileName, "\") + 1)
End Function

Public Function RemoveInvalidCharsFromFileName(FileName As String) As String
    ' remove illegal characters from filenames
    Dim newString As String
    newString = Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace( _
    FileName, "|", ""), ">", ""), "<", ""), Chr(34), ""), "?", ""), "*", ""), ":", ""), "/", ""), "\", "")
    RemoveInvalidCharsFromFileName = newString
End Function

Public Function Exists_FileFolder(PathName As String) As Boolean
'Author       : Ken Puls (www.excelguru.ca)
'Macro Purpose: Check if a file or folder exists
    On Error GoTo EarlyExit
    If Not Dir(PathName, vbDirectory) = vbNullString Then Exists_FileFolder = True
EarlyExit:
    On Error GoTo 0
End Function