アドインやテンプレートのバージョンチェックを行うVBAマクロ

ホーム
Office関連, Excel, Word, PowerPoint
アドインやテンプレートのバージョンチェックを行うVBAマクロ

Office関連

2014.12.26

アドインやテンプレートのバージョンチェックを行うVBAマクロ

色々なアプリケーションに実装されている、「最新バージョンの確認」機能、VBAマクロのアドインやテンプレートではどのように実装したらよいのか、簡単な処理を考えてみました。

色々な方法があると思いますが、まず思いついたのはXMLを使う方法。

下記のようなXMLをインターネット上の適当な場所に保存(下記例ではhttp://localhost/update.xml)しておいて、マクロからそのXMLを読み込みバージョンの比較を行う、というものです。

■ update.xml(UTF-8 BOM無し)

<?xml version="1.0" encoding="utf-8"?>
<update>
  <apps>
    <app id="AP001">
      <version>1.0.1</version>
      <url>http://localhost/apps/AP001.html</url>
    </app>
  </apps>
</update>

■ 標準モジュール

Option Explicit

Private Const AppID As String = "AP001" 'アプリケーション識別用のID
Private Const AppVer As String = "1.0.0" '現バージョン
Private Const ChkXmlUrl As String = "http://localhost/update.xml" 'バージョンチェック用XML

Private Sub ChkVersion()
'アプリケーションのバージョンチェック
  Dim xml As String
  Dim ver As String
  Dim url As String
  
  xml = "": ver = "": url = "" '初期化
  With CreateObject("WinHttp.WinHttpRequest.5.1")
    .Open "GET", ChkXmlUrl, False
    .SetRequestHeader "Content-Type", "application/xml; charset=UTF-8"
    .Send
    Select Case .Status
      Case 200: xml = .ResponseText
      Case Else: GoTo Err
    End Select
  End With
  If Len(Trim(xml)) < 1 Then GoTo Err
  
  With CreateObject("MSXML2.DOMDocument")
    .async = False
    If .LoadXML(xml) = True Then
      With .SelectNodes("/update/apps/app[@id='" & AppID & "']")
        If .Length > 0 Then
          On Error GoTo Err
          ver = .Item(0).SelectSingleNode("version").Text
          On Error GoTo 0
          If Len(Trim(ver)) > 0 Then
            If VerToNum(AppVer) < VerToNum(ver) Then
              Select Case MsgBox("現在お使いのアプリケーションは最新バージョンではありません。" & vbCrLf & _
                                 "最新バージョン [" & ver & "] のダウンロードページを表示しますか？", _
                                 vbQuestion + vbYesNo + vbSystemModal)
                Case vbYes
                  On Error GoTo Err
                  url = .Item(0).SelectSingleNode("url").Text
                  On Error GoTo 0
                  If Len(Trim(url)) > 0 Then
                    With CreateObject("InternetExplorer.Application")
                      .Visible = True
                      .Navigate url
                    End With
                  Else
                    GoTo Err
                  End If
                  Exit Sub
              End Select
              Exit Sub
            Else
              MsgBox "最新バージョンのアプリケーションです。", vbInformation + vbSystemModal
              Exit Sub
            End If
          Else
            GoTo Err
          End If
        Else
          GoTo Err
        End If
      End With
    Else
      GoTo Err
    End If
  End With
  
  Exit Sub
Err:
  MsgBox "バージョンチェックに失敗しました。" & vbCrLf & _
         "処理を中止します。", vbCritical + vbSystemModal
End Sub

Private Function VerToNum(ByVal ver As String) As Long
'アプリケーションのバージョン番号に入っている[.]を削除
  VerToNum = CLng(Replace(ver, ".", ""))
End Function

上記マクロは、インターネット上のXMLから最新バージョンの番号を読み取り、定数として保持していた番号より新しければ、アプリケーションのダウンロードページを開くという、非常にシンプルなものです。

XMLを下記のようにすれば、複数のアプリケーションのバージョンを一つのファイルで管理することもできます。

<?xml version="1.0" encoding="utf-8"?>
<update>
  <apps>
    <app id="AP001">
      <version>1.0.1</version>
      <url>http://localhost/apps/AP001.html</url>
    </app>
    <app id="AP002">
      <version>2.0.0</version>
      <url>http://localhost/apps/AP002.html</url>
    </app>
    <app id="AP003">
      <version>0.0.5</version>
      <url>http://localhost/apps/AP003.html</url>
    </app>
  </apps>
</update>

また、上記XMLではダウンロードページのURLを指定していますが、ファイルのダウンロード先を直接指定することで、マクロから最新バージョンのファイルをダウンロードすることもできるでしょう(「VBAでインターネット上のファイルをダウンロードする方法をまとめてみました。」参照)。

このあたりの細かい動作は、自分の好みで実装すれば良いかと思います。