Content
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. It is not
unusual that you have discovered (or been pointed at) bugs in your code
or that you've done some updating to the utility you'd like your users to
benefit from. Sometimes it might be useful if your users could be notified
automatically of such 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 a 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).
- The code will create a webquery in a cell that points to that webpage.
The cell is named "Available_Build".
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 refreshes its web query and 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. I don't know if it works
in all cases though and would be pleased to get your feedback on that
(use form at bottom of page or send me an email).
- A message is shown that asks the user to reopen Excel.
- Excel opens the new file. This file also contains code that removes
the "(OldVersion)" file.
Update modes
The code handles two modes, automatic updates and manual update checks.
In the automatic case, the webquery is added to the addin, but is refreshed
asynchronously. A worksheet change event is scheduled in the class module,
which will fire as soon as the webquery has finished updating (or has timed
out). This is done so the check for an update can run in the background
whilst Excel finishes its startup process. The user won't have to wait (well,
not noticably anyway) for your update to do its work.
In the manual case, the web query is updated synchronously (nothing will
work in Excel until it has retrieved its result). I did this because in
this case you will confuse your user of he does not get "immediate" feedback
on the result.
Code
The code that does the actual updating is wrapped in a class module called
"clsUpdate", see the entire code below.
Option Explicit
'-------------------------------------------------------------------------
' 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
Public WithEvents
Sht As Worksheet
#If VBA7 Then
Private Declare
PtrSafe Function URLDownloadToFile
Lib "urlmon" _
Alias "URLDownloadToFileA" (ByVal
pCaller As Long,
_
ByVal
szURL As String,
ByVal szFileName As
String, _
ByVal
dwReserved As Long,
ByVal lpfnCB As
Long) As
Long
#Else
Private Declare
Function URLDownloadToFile
Lib "urlmon" _
Alias "URLDownloadToFileA" (ByVal
pCaller As Long,
_
ByVal
szURL As String,
ByVal szFileName As
String, _
ByVal
dwReserved As Long,
ByVal lpfnCB As
Long) As
Long
#End If
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 Sub Class_Terminate()
Set Sht = Nothing
End Sub
Private Sub DownloadFile(strWebFilename
As String, strSaveFileName
As String)
' Download the file.
URLDownloadToFile 0, strWebFilename, strSaveFileName, 0,
0
End Sub
Public Function
IsThereAnUpdate(Optional bShowMsg
As Boolean =
False) As
Boolean
Dim sNewBuild
As String
On Error
Resume Next
SaveSetting AppName, "Updates", "LastUpdate",
CStr(Int(Now))
If Err.Number <> 0 And bShowMsg
Then
MsgBox "Error retrieving update
information, please try again later.", vbInformation + vbOKOnly
End If
End Function
Public Sub DoUpdate()
Dim sNewBuild
As String
sNewBuild = ThisWorkbook.Names("Available_build").RefersToRange.Value
If Len(sNewBuild) = 0
Or Len(sNewBuild) > 4
Then
MsgBox "Unable to fetch version
information, please try again later.", vbOKOnly + vbInformation
Exit
Sub
End If
If CLng(sNewBuild) >
CLng(msBuild) Then
If MsgBox("We
have an update, do you wish to download?", vbQuestion + vbYesNo) = vbYes
Then
DownloadName
= "https://jkp-ads.com/downloadscript.asp?filename=" & ThisWorkbook.Name
If
GetUpdate Then
Application.Cursor
= xlDefault
MsgBox
"Successfully updated the addin, please restart Excel to start using
the new version!", vbOKOnly + vbInformation
Else
Application.Cursor
= xlDefault
MsgBox
"Updating has failed.", vbInformation + vbOKOnly
End
If
Else
Application.Cursor
= xlDefault
End
If
ElseIf Manual
Then
Application.Cursor = xlDefault
MsgBox "Your program is up to date.",
vbInformation + vbOKOnly
End If
TidyUp:
On Error
GoTo 0
Exit Sub
End Sub
Private Sub Sht_Change(ByVal
Target As Range)
Application.Cursor = xlDefault
If Len(Target.Value) <= 4
Then
DoUpdate
Application.Cursor = xlDefault
ElseIf Manual
Then
'Query failed
to refresh and was called manually
Application.Cursor = xlDefault
MsgBox "Unable to retrieve version
information, please try again later", vbInformation + vbOKOnly
End If
Set Sht = Nothing
TidyUp:
On Error
GoTo 0
Exit Sub
End Sub
Public Sub PlaceBuildQT(ByVal
bManual As Boolean)
Dim oNm As
Name
On Error
GoTo LocErr
Application.ScreenUpdating = False
For Each
oNm In ThisWorkbook.Worksheets("Sheet1").Names
oNm.Delete
Next
If CInt(Left(Application.Version,
2)) > 11 Then
' Trick!! Somehow
Excel 2007 cannot insert a web query into an add-in!!
ThisWorkbook.IsAddin =
False
End If
With ThisWorkbook.Worksheets("Sheet1").QueryTables.Add(Connection:=
_
"URL;" & CheckURL, Destination:=ThisWorkbook.Names( _
"Available_Build").RefersToRange)
.Name = "autosafebuild"
.FieldNames =
True
.RowNumbers =
False
.FillAdjacentFormulas =
False
.PreserveFormatting =
True
.RefreshOnFileOpen =
False
.BackgroundQuery =
Not bManual
.RefreshStyle = xlOverwriteCells
.SavePassword =
False
.SaveData = True
.AdjustColumnWidth =
False
.RefreshPeriod = 0
.WebSelectionType = xlEntirePage
.WebFormatting = xlWebFormattingNone
.WebPreFormattedTextToColumns =
True
.WebConsecutiveDelimitersAsOne =
True
.WebSingleBlockTextImport =
False
.WebDisableDateRecognition =
False
' .WebDisableRedirections
= False
On
Error Resume
Next
.Refresh BackgroundQuery:=Not
(bManual)
On
Error GoTo 0
If
Not bManual Then
Set
Sht = ThisWorkbook.Worksheets("Sheet1")
Else
DoUpdate
End
If
End With
TidyUp:
If CInt(Left(Application.Version,
2)) > 11 Then
ThisWorkbook.IsAddin =
True
' Trick!! Otherwise,
Excel 2007 will ask to save your add-in when it closes.
ThisWorkbook.Saved =
True
End If
Application.ScreenUpdating = True
On Error
GoTo 0
Exit Sub
LocErr:
If CInt(Left(Application.Version,
2)) > 11 Then
ThisWorkbook.IsAddin =
True
ThisWorkbook.Saved =
True
End If
Application.ScreenUpdating = True
Application.Cursor = xlDefault
If Err.Description
Like "*QueryTables*" Then
MsgBox "Error retrieving version
information, please try again later.", vbInformation + vbOKOnly
Resume
TidyUp
End If
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()
CurrentAddinName = ThisWorkbook.FullName
TempAddInName = CurrentAddinName & "(OldVersion)"
On Error
Resume Next
Kill TempAddInName
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
dtNow = Int(Now)
mdtLastUpdate = CDate(GetSetting(AppName,
"Updates", "LastUpdate", "0"))
If mdtLastUpdate = 0
Then
'Never checked
for an update, save today!
SaveSetting AppName, "Updates",
"LastUpdate", CStr(Int(dtNow))
End If
LastUpdate = mdtLastUpdate
End Property
Public Property
Let LastUpdate(ByVal
dtLastUpdate As Date)
mdtLastUpdate = dtLastUpdate
SaveSetting AppName, "Updates", "LastUpdate",
CStr(Int(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
Alternatively, we could do this with the InternetExplorer control (and
thus need a reference to the associated library) . This could be done like
this:
Public Function
IsThereAnUpdateUsingIE() As
Boolean
Dim oIE As
InternetExplorer
Set oIE = New
InternetExplorer
With oIE
.Navigate2 CheckURL
Do
Loop
Until .Busy = False
If Len(.Document.body.innerhtml) >
0 Then
If
CLng(.Document.body.innerhtml) >
CLng(Build) Then
IsThereAnUpdate
= True
End
If
End
If
.Quit
End With
Set oIE = Nothing
End Function
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 Function
InternetGetConnectedState _
Lib "wininet.dll" (lpdwFlags As
Long, _
ByVal
dwReserved As Long)
As Boolean
Function IsConnected()
As Boolean
Dim Stat As
Long
IsConnected = (InternetGetConnectedState(Stat, 0&) <>
0)
End Function
Sub AutoUpdate()
CheckAndUpdate False
End Sub
Sub ManualUpdate()
On Error
Resume Next
Application.OnTime Now, "CheckAndUpdate"
End Sub
Public Sub CheckAndUpdate(Optional
bManual As Boolean
= True)
Set mcUpdate =
New clsUpdate
If bManual
Then
Application.Cursor = xlWait
End If
With mcUpdate
'Set intial values
of class
'Current build
.Build = 0
'Name of this
app, probably a global variable, such as GSAPPNAME
.AppName = "UpdateAnAddin"
'Get rid of possible
old backup copy
.RemoveOldCopy
'URL which contains
build # of new version
.CheckURL = "https://jkp-ads.com/UpdateAnAddinBuild.asp"
'Started check
automatically or manually?
.Manual = bManual
'Check once a
week
If (Now
- .LastUpdate >= 7) Or bManual
Then
.PlaceBuildQT
bManual
End
If
End With
TidyUp:
On Error
GoTo 0
Exit Sub
End Sub
Download Demo
Download the demo file here:
Update An addin