Updating An add-in Through the Internet

Content

Introduction
Assumptions for this article
Updating mechanism
Update modes
Code
Download Demo

Introduction

When you're offering an add-in through your website you usually have no connection to the people who are using your programming work. Sometimes it might be useful if your users could be automatically notified of updates (many software titles have such a mechanism built-in). This little article shows a way to include that functionality with your add-in.

Assumptions for this article

I've assumed the following:

You only want to update the add-in itself, not any accompanying files.
The name of the download file is identical to the add-in's filename.
Your add-in has a build number.
There is an html page on your website (or you render one on demand extracting the build number from a database using a query in some php or asp code) which contains nothing else than a build number (no HTML tags surrounding the number).

Updating mechanism

The updating process works as follows:

The add-in checks when the last update check has been performed.
If this is more than 7 days ago (or has never been done before), the check is started.
The add-in compares build numbers.
If build on web is higher, permission is asked to download and update.
The current add-in saves itself, appending "(OldVersion)" to its filename (this enables us to overwrite the old add-in with the new one).

Note: I've tried whether marking the add-in file as read-only would enable the code to delete the file itself, but this appears not to work when the file is on a local drive. I've heard reports that when the add-in is on a network folder, this does work.

A message is shown that asks the user to restart Excel.
On restart, Excel opens the new file. The "(OldVersion)" file is deleted.

Update modes

The code handles two modes, automatic updates and manual update checks.

In the automatic case, the check for updates is done only once per week.

In the manual case, the check is done immediately, regardles of when the last check was done.

Code

The code that does the actual updating is wrapped in a class module called "clsUpdate":

'-------------------------------------------------------------------------
' Module    : clsUpdate
' Company   : JKP Application Development Services (c)
' Author    : Jan Karel Pieterse
' Created   : 19-2-2007
' Purpose   : Class to check for program updates
'-------------------------------------------------------------------------
Option Explicit

Private Declare PtrSafe Function URLDownloadToFile Lib "urlmon" _
        Alias "URLDownloadToFileA" (ByVal pCaller As LongPtr, _
                                    ByVal szURL As String, ByVal szFileName As String, _
                                    ByVal dwReserved As LongPtr, ByVal lpfnCB As LongPtr) As Long

Private mdtLastUpdate As Date

Private msAppName As String
Private msBuild As String
Private msCheckURL As String
Private msCurrentAddinName As String
Private msDownloadName As String
Private msTempAddInName As String
Private mbManual As Boolean
Private msNewBuild As String

Private Sub DownloadFile(strWebFilename As String, strSaveFileName As String)
' Download the file.
    URLDownloadToFile 0, strWebFilename, strSaveFileName, 0, 0
End Sub

Public Function IsThereAnUpdate(sError As String, Optional bShowMsg As Boolean = False) As Boolean
'-------------------------------------------------------------------------
' Procedure : IsThereAnUpdate
' Company   : JKP Application Development Services (c)
' Author    : Jan Karel Pieterse (www.jkp-ads.com)
' Created   : 2-6-2009
' Purpose   : Fetches version information from a webpage
'-------------------------------------------------------------------------
    Dim oHTTP As MSXML2.XMLHTTP
    Dim sURL As String
    Dim lError As Long
    Dim sTextResponse As String
    Dim dTime As Double
    Dim ct As Long
    On Error GoTo LocErr
    sURL = CheckURL
    Set oHTTP = New MSXML2.XMLHTTP
    NewBuild = 0
    lError = 0
    With oHTTP
        .Open "get", sURL & "?" & Format(Date + Time, "yyyymmdd_hhmmss"), True
        .setRequestHeader "pragma", "no-cache"
        .setRequestHeader "cache-control", "no-store, must-revalidate, private"
        .Send ""
        dTime = Now
        Application.StatusBar = Me.AppName & " is checking for updates"
        Do
            DoEvents
            ct = ct + 1
            If ct Mod 500 = 0 Then
                Application.StatusBar = Me.AppName & " is checking for updates " & Format(TimeValue("00:00:05") - (Now - dTime), "s")
            End If
        Loop Until Now - dTime > TimeValue("00:00:05") Or .readyState = 4
        sTextResponse = .responseBody

        Select Case True
        Case Err.Number <> 0
            sError = " ##Error " & Err.Number & ": " & Err.Description
            IsThereAnUpdate = False
        Case InStr(sTextResponse, "404 Not Found")
            sError = " ##Error## 404 Not Found."
            IsThereAnUpdate = False
        Case Else
            NewBuild = Val(sTextResponse)
            IsThereAnUpdate = True
        End Select
        On Error GoTo 0
    End With

TidyUp:
    On Error Resume Next
    Set oHTTP = Nothing
    Exit Function
LocErr:
    Select Case ReportError(Err.Description, Err.Number, "IsThereAnUpdate", "Class Module clsUpdate")
    Case vbRetry
        Resume
    Case vbIgnore
        Resume Next
    Case vbAbort
        Resume TidyUp
    End Select
End Function

Public Sub DoUpdate()
    Dim sNewBuild As String
    Dim sError As String
    On Error GoTo LocErr
    If IsThereAnUpdate(sError, Manual) Then
        If CLng(NewBuild) > CLng(Build) Then
            If MsgBox("There is an update for " & AppName & "." & _
                      vbNewLine & "Do you wish to download now?", vbQuestion + vbYesNo, AppName) = vbYes Then
                If GetUpdate Then
                    Application.Cursor = xlDefault
                    MsgBox "Successfully updated the " & AppName & " Add-In, " & vbNewLine & _
                           "please restart Excel to start using the new version!", vbOKOnly + vbInformation, AppName
                Else
                    Application.Cursor = xlDefault
                    MsgBox "Updating " & AppName & " has failed, please try again later.", _
                           vbInformation + vbOKOnly, AppName
                End If
            End If
        ElseIf Manual Then
            Application.Cursor = xlDefault
            MsgBox AppName & " is up to date.", vbInformation + vbOKOnly, AppName
        End If
    Else
        MsgBox "Error fetching version information: " & sError, vbExclamation + vbOKOnly, AppName
    End If
TidyUp:
    On Error GoTo 0
    Exit Sub
LocErr:
    Select Case ReportError(Err.Description, Err.Number, "DoUpdate", "Class Module clsUpdate")
    Case vbRetry
        Resume
    Case vbIgnore
        Resume Next
    Case vbAbort
        Resume TidyUp
    End Select
End Sub

Public Property Get Build() As String
    Build = msBuild
End Property

Public Property Let Build(ByVal sBuild As String)
    msBuild = sBuild
End Property

Public Sub RemoveOldCopy()
    On Error GoTo LocErr
    CurrentAddinName = ThisWorkbook.FullName
    TempAddInName = CurrentAddinName & "(OldVersion)"
    On Error Resume Next
    Kill TempAddInName
TidyUp:
    On Error GoTo 0
    Exit Sub
LocErr:
    Select Case ReportError(Err.Description, Err.Number, "RemoveOldCopy", "Class Module clsUpdate")
    Case vbRetry
        Resume
    Case vbIgnore
        Resume Next
    Case vbAbort
        Resume TidyUp
    End Select
End Sub

Public Function GetUpdate() As Boolean
    On Error Resume Next
    'If workbook has been saved readonly, we can safely delete the file!
    If ThisWorkbook.ReadOnly Then
        Err.Clear
        Kill CurrentAddinName
    End If
    LastUpdate = Now
    ThisWorkbook.SaveAs TempAddInName
    DoEvents
    Kill CurrentAddinName
    On Error GoTo 0
    DownloadFile DownloadName, CurrentAddinName
    If Err = 0 Then GetUpdate = True
End Function

Private Property Get CurrentAddinName() As String
    CurrentAddinName = msCurrentAddinName
End Property

Private Property Let CurrentAddinName(ByVal sCurrentAddinName As String)
    msCurrentAddinName = sCurrentAddinName
End Property

Private Property Get TempAddInName() As String
    TempAddInName = msTempAddInName
End Property

Private Property Let TempAddInName(ByVal sTempAddInName As String)
    msTempAddInName = sTempAddInName
End Property

Public Property Get DownloadName() As String
    DownloadName = msDownloadName
End Property

Public Property Let DownloadName(ByVal sDownloadName As String)
    msDownloadName = sDownloadName
End Property

Public Property Get CheckURL() As String
    CheckURL = msCheckURL
End Property

Public Property Let CheckURL(ByVal sCheckURL As String)
    msCheckURL = sCheckURL
End Property

Public Property Get LastUpdate() As Date
    Dim dtNow As Date
    On Error GoTo LocErr
    dtNow = Int(Now)
    mdtLastUpdate = CDate(GetSetting(AppName, "Updates", "LastUpdate", "0"))
    If mdtLastUpdate = 0 Then
        'Never checked for an update, save today!
        LastUpdate = dtNow
    End If
    LastUpdate = mdtLastUpdate
TidyUp:
    On Error GoTo 0
    Exit Property
LocErr:
    Select Case ReportError(Err.Description, Err.Number, "LastUpdate", "Class Module clsUpdate")
    Case vbRetry
        Resume
    Case vbIgnore
        Resume Next
    Case vbAbort
        Resume TidyUp
    End Select
End Property

Public Property Let LastUpdate(ByVal dtLastUpdate As Date)
    mdtLastUpdate = dtLastUpdate
    SaveSetting AppName, "Updates", "LastUpdate", CStr(CLng(mdtLastUpdate))
End Property

Public Property Get AppName() As String
    AppName = msAppName
End Property

Public Property Let AppName(ByVal sAppName As String)
    msAppName = sAppName
End Property

Public Property Get Manual() As Boolean
    Manual = mbManual
End Property

Public Property Let Manual(ByVal bManual As Boolean)
    mbManual = bManual
End Property

Public Property Get NewBuild() As String
    NewBuild = msNewBuild
End Property

Public Property Let NewBuild(ByVal sNewBuild As String)
    msNewBuild = sNewBuild
End Property

In a normal module, we create an instance of this class, set its initial values and do the updating. The comments in the code describe what is being done:

Option Explicit

Dim mcUpdate As clsUpdate

Public Declare PtrSafe Function InternetGetConnectedState _
                         Lib "wininet.dll" (lpdwFlags As LongPtr, _
                                            ByVal dwReserved As Long) As Boolean

Function IsConnected() As Boolean
    Dim Stat As LongPtr
    IsConnected = (InternetGetConnectedState(Stat, 0&) <> 0)
End Function

Sub ManualUpdate()
    On Error Resume Next
    Application.OnTime Now, "'" & ThisWorkbook.FullName & "'!CheckAndUpdate"
End Sub

Public Sub CheckAndUpdate(Optional bManual As Boolean = True)
    On Error GoTo LocErr
    Set mcUpdate = New clsUpdate
    If bManual Then
        Application.Cursor = xlWait
    End If
    With mcUpdate
        'Set intial values of class
        'Current build
        .Build = BUILDOFAPP
        'Name of this app
        .AppName = "UpdateAnAddin"
        'Get rid of possible old backup copy
        .RemoveOldCopy
        'URL which contains build # of new version
        .CheckURL = "https://jkp-ads.com/updateanaddinbuild.aspx"
        .DownloadName = "https://jkp-ads.com/downloadscript.aspx?filename=" & ThisWorkbook.Name
        'Started check automatically or manually?
        .Manual = bManual
        'Check once a week
        If (Now - .LastUpdate >= 7) Or bManual Then
            .LastUpdate = Int(Now)
            .DoUpdate
        End If
        Set mcUpdate = Nothing
    End With
TidyUp:
    On Error GoTo 0
    Application.Cursor = xlDefault
    Exit Sub
LocErr:
    Select Case ReportError(Err.Description, Err.Number, "CheckAndUpdate", "Module modUpdate")
    Case vbRetry
        Resume
    Case vbIgnore
        Resume Next
    Case vbAbort
        Resume TidyUp
    End Select
End Sub

Finally, we have a module called modGlobals, which holds our project-level variables and constants:

Option Explicit

Public Const GSAPPNAME As String = "Update Addin Demo"
Public Const BUILDOFAPP As String = "1" '< change to 0 to test doenloading the new version