Updating An add-in Through the Internet
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
'-------------------------------------------------------------------------
' 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
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
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
Comments
Showing last 8 comments of 110 in total (Show All Comments):Comment by: Daniel (4-6-2022 18:07:00) deeplink to this comment
How do you set a build number for excel add-ins?
Comment by: Jan Karel Pieterse (4-6-2022 18:33:00) deeplink to this comment
Hi Daniel,
That can be done using any convenient method, such as setting a constant in the vba code, or an entry in a dedicated cell of the addin.
Comment by: Asmita (10-6-2024 13:59:00) deeplink to this comment
Hi Jan,
How to add newly created tags in existing project tag in Add-ins?
Please guide
Comment by: Jan Karel Pieterse (10-6-2024 16:55:00) deeplink to this comment
Hi Asmita,
I'm not sure I understand what you mean?
Comment by: Asmita (10-6-2024 17:01:00) deeplink to this comment
Have created new sub tags using macro, but those are not being added in the existing Tab(created abc as project name) like Developer tab. But those sub tags are not getting added in "abc" main Tab in excel - Working with Add-in here
Comment by: Jan Karel Pieterse (11-6-2024 09:46:00) deeplink to this comment
Hi Asmita,
I'm still not sure. What exactly do you mean by "sub tags". Sub tags of what object exactly? Is this a VBA question?
Comment by: 1997ismail.hosen@gmaill.com (19-6-2024 11:49:00) deeplink to this comment
What about new Microsoft blocking macro issue by default for M365? Does this work on Mac in Excel as well?
Comment by: Jan Karel Pieterse (19-6-2024 14:02:00) deeplink to this comment
Hi Ismail,
Mac doesn't have MOTW, so isn't an issue there. Mac has other issues, like users having to permit access to certain folders.
Have a question, comment or suggestion? Then please use this form.
If your question is not directly related to this web page, but rather a more general "How do I do this" Excel question, then I advise you to ask your question here: www.eileenslounge.com.