[AddIn] AutoUpdate d'une macro-complémentaire Add-In [FAQ]

[cafeine]

Voici une méthode pour permettre la mise à jour automatique d'un Add-In distribué sur un réseau local d'entreprise.
On peut imaginer le même fonctionnement avec un Add-In sur le net.

Fonctionnement :
- vous mettez votre add-in a distribuer à un emplacement fixe
- vous devez gérer un fichier *.ini qui vérifie toutes les semaines la version.
- si la version sur le réseau est plus récente le programme propose la mise à jour
- la mise à jour consiste à archiver l'actuel add-in avant de copier la nouvelle version.

les fonctions de lecture/écriture de fichier INI

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
Private Declare Function GetPrivateProfileString Lib "kernel32" Alias _
        "GetPrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, _
        ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Long, _
        ByVal lpFileName As String) As Long
 
Private Declare Function WritePrivateProfileString Lib "kernel32" Alias _
        "WritePrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, _
        ByVal lpString As Any, ByVal lpFileName As String) As Long
 
Function EcrireINI(Entete As String, Variable As String, Valeur As String) As String
    Dim Fichier As String
    Fichier = "C:\temp\MyAddin.ini"
    WriteINI = WritePrivateProfileString(Entete, Variable, Valeur, Fichier)
End Function
 
Function LireINI(Entete As String, Variable As String) As String
    Dim Retour As String
    Dim Fichier As String
    Fichier = "C:\temp\MyAddin.ini"
    Retour = String(255, Chr(0))
    LireINI = Left$(Retour, GetPrivateProfileString(Entete, ByVal Variable, "", Retour, Len(Retour), Fichier))
End Function

sur l'événement Workbook_Open de la macro-complémentaire

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
Private Sub Workbook_Open()
 
' check UPDATE
If LireINI("Main", "lastCheckUpdate") & "" = "" Then
    CheckVersion
    EcrireINI "Main", "lastCheckUpdate", Format(Now, "dd/mm/yyyy hh:nn:ss")
Else
    If CDate(LireINI("Main", "lastCheckUpdate")) + 7 < Now Then
        CheckVersion
        EcrireINI "Main", "lastCheckUpdate", Format(Now, "dd/mm/yyyy hh:nn:ss")
    End If
End If
 
End Sub

puis un module de code

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
Sub CheckVersion()
 
    Dim fso As FileSystemObject
    Dim ad As AddIn
 
    Set fso = New FileSystemObject
 
    For Each ad In application.AddIns
        If ad.FullName Like "*MyAddin.xla" Then
            If fso.GetFile(ad.FullName).DateLastModified < _
       fso.GetFile("\\LecteurReseau\...\Divers\MyAddin.xla").DateLastModified Then
                rep = MsgBox("Votre version de l'Add-in n'est plus à jour." & vbCrLf & _
                            "Voulez-vous mettre à jour votre Add-in ?", vbInformation + vbYesNo, "MyAddin")
                If rep = vbYes Then
                    ' il faut mettre à jour
                    On Error Resume Next
                    Kill Left(ad.FullName, Len(ad.FullName) - 4) & "(old).xla"
                    ThisWorkbook.SaveAs Left(ad.FullName, Len(ad.FullName) - 4) & "(old).xla"
                    FileCopy _
                            "\\LecteurReseau\...\Divers\MyAddin.xla", _
                            ad.FullName
                    MsgBox "La mise à jour de votre Add-in a été effectuée." & vbCrLf & _
                           "Redémarrez Excel pour qu'elle soit effective", vbInformation + vbOKOnly, _
                           "MyAddin"
                Else
                    MsgBox "La prochaine vérification aura lieu dans une semaine !", _
                            vbCritical + vbOKOnly, _
                            "MyAddin"
                End If
            End If
        End If
    Next ad
 
    Set fso = Nothing
    Set ad = Nothing
End Sub