双击打开Excel加载项xlam时自动安装或更新加载项Add-In

原创文章,欢迎转载:http://miao.blog/article/xlam-auto-install

先插入一个类模块: cAddInManager

' Add-In name
Private add_in_name As String

' Add-In version
Private add_in_version As String

' Excel Add-In folder path
Private excel_add_in_folder_path As String

' Install Add-In
Sub Install(add_in_name_ As String, version As String)
    On Error GoTo ErrorHandler
    
    ' Init variables
    add_in_name = add_in_name_
    add_in_version = version
    excel_add_in_folder_path = "C:\Users\" & Environ("username") & "\AppData\Roaming\Microsoft\AddIns"

    ' Exit if open from addin folder
    If ThisWorkbook.Path = excel_add_in_folder_path Then Exit Sub
    
    ' If add in exists, reinstall or not
    If AddInExists Then
        If MsgBox("This Add-In(" & add_in_name & ") is installed, need to update?", vbYesNo) = vbYes Then
            
            ' Uninstall Add-In
            Application.AddIns(add_in_name).Installed = False
            
            ' Install Add-In
            Call InstallAddIn("update")
            
            ' Notice updated message
            MsgBox "Congratulations! Add-In(" & add_in_name & ") is updated to " & add_in_version, vbInformation
        End If
    
    ' If Add-In not exists, install it
    Else
        If MsgBox("Install this Add-In(" & add_in_name & ")?", vbYesNo) = vbYes Then
            
            ' Install Add-In
            Call InstallAddIn
            
            ' Notice installed message
            MsgBox "Congratulations! Add-In(" & add_in_name & " " & add_in_version & ") is installed!", vbInformation
        End If
    End If
    
    ' Close this workbook
    ThisWorkbook.Close False
    Exit Sub
ErrorHandler:
    MsgBox Err.Description, vbCritical
    ThisWorkbook.Close False
End Sub

' Instal Add-In
Private Sub InstallAddIn(Optional handle As String = "install")
    
    ' Copy to Add-In path
    Dim add_in_path As String: add_in_path = excel_add_in_folder_path & "\" & add_in_name & ".xlam"
    With CreateObject("Scripting.FileSystemObject")
        .CopyFile ThisWorkbook.FullName, add_in_path, True
    End With
    
    ' If there are no active sheets, there will be an error when installing Add-In
    If Not HasActiveWorkbook Then Workbooks.Add
    
    ' Install
    Application.AddIns.Add(add_in_path).Installed = True
End Sub

' If add in exists
Private Property Get AddInExists() As Boolean
    If add_in_name = "" Then AddInExists = False: Exit Property
    
    ' for each to find
    Dim add_in As AddIn
    For Each add_in In Application.AddIns
        If add_in.Title = add_in_name Then
            AddInExists = True
            Exit For
        End If
    Next
End Property

' Check if has no active workbook
Private Property Get HasActiveWorkbook() As Boolean
    On Error GoTo ErrorHandler
    
    Dim value As String: value = ActiveSheet.Range("A1").value
    HasActiveWorkbook = True
    
    Exit Property
ErrorHandler:
    HasActiveWorkbook = False
End Property

然后在Workbook_Open事件中加入如下代码

Private Sub Workbook_Open()
    With New cAddInManager
        .Install "Workhour Helper", "v1.0.2"
    End With
End Sub

搞定哈哈
另外注意Add-In的文件名跟扩展名不能一样,不然会出现Add-In一直重复加载的神奇问题。
建议就是文件名带上版本号,而扩展名不带版本号即可。比如你的文件时 Workhour Helper v1.0.2.xlam,你的扩展名设置为 Workhour Helper

推荐阅读
vba要实现md5必须引用外部库,导致vba程序交付安装不是很方便。很多时候我们并不是想要取真正的md5,只是取一个加密字符串,比如保存密码的时候。本文中的代码直接利用windows系统内置命令certutil -hashfile实现了一种变相的md5函数。代码要读写本地文件两次,因此效率不高,不过在登陆验证一下密码等场景并没有影响。
VBA中进行copy和paste的时候,无规律的出现 “类Worksheet的Paste方法无效”错误 怀疑是电脑太快,copy操作还没有完成,就直接运行paste,导致paste出错。 所以在copy操作后,sleep一小段时间,结果真的解决了问题。
评论