Accessファイルをオンライン更新するテクニック

Accessは小さなデータベースで、VBAが使えることから非常に多くの現場のシステム構築として利用されてきました。しかし、デメリットとして、アップデートをした場合にそのファイルの配布方法とアップデート方法に於いては、非常にアナログな手法が用いられており、管理するのが大変面倒ということは言われ続けてきました。

最近のアプリケーションのように、オンライン経由でアップデート通知や自動ダウンロード、サイレントアップデートなどができれば、このデメリットも大きく克服ができるのではと考え、今回自分が現場のシステムで使ってるオンラインアップデート方法について公開してみたいと思います。

今回使用するファイル

• 一番最初に起動させるデータベースファイル
• プログラム本体のファイル
• アップデート情報の入ったXMLファイル
• アップデートする本体の入ったZIPファイル

仕組み

今回のこの仕組はオンラインといっても、ファイルサーバーでも良いですし、どこかのクラウド上で直リンクでダウンロードできるならば使える仕組みです。今回使用するファイルのうち

• アップデート情報の入ったXMLファイル
• アップデートする本体の入ったZIPファイル

の２つはオンライン上のどこかに配置しなければなりません。今回は、https://officeforest.org/update/以下にこの２つのファイルを保存してあります。

その後、実際にアップデートする場合には、以下の手順でファイルを差し替えます。

1. XMLファイルのverの項目を最新のバージョン数値に書き換え、サーバ上のファイルを差し替える
2. そのバージョンに該当するファイルをupdate.zipとして圧縮し、サーバ上のファイルを差し替える

配布済みのプログラムは最初に起動させるのは、start.accdb（一番最初に起動させるデータベースファイル）としプログラムであるtestdatabase.accdb（プログラム本体のファイル）は直接は起動させません。start.accdbがアップデート情報を読み取り、更新後にtest.accdbを起動する仕組みになっている為です。

※現在のプログラム本体のファイルのバージョン情報は、start.accdbのsettingテーブルに入っています。

図：Webサーバ上にファイルを配置してみた

ソースコード

XMLファイルのコード

<?xml version="1.0" encoding="utf-8"?>
<dataroot xmlns:od="urn:schemas-microsoft-com:officedata" generated="2010-03-30T11:58:39">
  <アップデータ>
    <ver>2.0</ver>
    <zip>https://officeforest.org/update/update.zip</zip>
  </アップデータ>
</dataroot>

• verは最新バージョンのバージョン数値
• zipは最新バージョンのファイルがある場所のURLを記述

start.accdb起動時に実行するコード

Option Compare Database

'ファイルのダウンロード用
Public 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 Long) As LongPtr
 
'ウィンドウの表示コントロール用
Declare PtrSafe Function ShowWindow Lib "User32" ( _
    ByVal hWnd As LongPtr, ByVal nCmdShow As LongPtr) As LongPtr
Const SW_SHOWMINIMIZED = 2

'アップデート確認とプログラム本体の起動ルーチン
Function updateexec()
    '変数の宣言
    Dim ret As Variant
    Dim temppath As Variant
    Dim xmlDoc As MSXML2.DOMDocument60
    Dim XmlPath As String
    Dim XmlEl As IXMLDOMElement
    Dim XmlNodl As IXMLDOMNodeList
    Dim XmlNode As IXMLDOMNode
    Dim wmi, value, sha, sfo
    Dim zipFile As String
    Dim xmlfile As String
    Dim iniver As Double
    Dim newverhit As Double
    Dim appfilepath As String
    Dim stAppName As String
    Dim accesspath As String
    Dim updateflag As Variant
    Dim result As Variant
    Dim securepath As Variant
    Dim accver As Variant
    
    'フラグの初期化
    updateflag = 0
    
    'アップデート対象のaccdb
    appfilepath = CurrentProject.path & "\testdatabase.accdb"
    
    '保存するzipファイルのパス
    temppath = CurrentProject.path & "\update.zip"
    
    '参照するアップデート情報ファイル
    xmlfile = "https://officeforest.org/update/ver.xml"
    
    '現在のバージョンを取得
    iniver = DLookup("バージョン", "setting", "ID=1")
    
    'Access本体のパスを取得する。
    accesspath = SysCmd(acSysCmdAccessDir) & "msaccess.exe"
      
    'ファイルの有無を調べる
    Dim oFs As Scripting.FileSystemObject
    Set oFs = New Scripting.FileSystemObject
    
    If IsNull(temppath) Then
        'ダウンロード済みファイルを削除しておく
        Kill temppath
    Else
        If oFs.FileExists(temppath) Then
            'ダウンロード済みファイルを削除しておく
            Kill temppath
        Else
        End If
    End If
    
    'XMLファイルのダウンロード
    ret = URLDownloadToFile(0, xmlfile, CurrentProject.path & "\ver.xml", 0, 0)
    
    If ret = 0 Then
        'XMLファイルの読み込みとバージョン比較
        Set xmlDoc = New MSXML2.DOMDocument60
        xmlDoc.async = False '同期読み込み
        XmlPath = xmlfile  'XMLファイルのインターネット上のパスの指定
        xmlDoc.Load (XmlPath) 'XMLファイルの読み込み
        Set XmlEl = xmlDoc.documentElement
        
        '最新のバージョンデータを取得
        Set XmlNodl = XmlEl.getElementsByTagName("ver")
        For Each XmlNode In XmlNodl
            newverhit = XmlNode.Text
        Next
        
        '最新版の在り処を取得
        Set XmlNodl = XmlEl.getElementsByTagName("zip")
        For Each XmlNode In XmlNodl
            zipFile = XmlNode.Text
        Next
        
        'バージョン比較
        If iniver < newverhit Then
            '新しいバージョンがリリースされてるケース
            'ZIPファイルをダウンロード実行
            ret = URLDownloadToFile(0, zipFile, temppath, 0, 0)
            
            'ファイル解凍ルーチン
            If ret = 0 Then
                'updateフラグを立てる
                updateflag = 1
            End If
        End If
    End If
    
    'updateflagを見て条件分岐
    If updateflag = 1 Then
        'アップデータを起動するかどうかを問い合わせして、YESの場合は、アップデータを起動。そうでない場合は既存ファイルを起動
        result = MsgBox("最新版がリリースされています。アップデートしますか？", vbYesNo + vbDefaultButton2 + vbExclamation)
        
        'ダイアログの問い合わせの回答によって条件分岐
        If result = vbYes Then
            'アップデートを実行する
            'ダウンロードしたファイルを解凍
            ret = zipmelt(temppath)
            
            'DB接続
            Dim db As dao.Database
            Dim rs As dao.Recordset
            Set db = CurrentDb()
            Set rs = db.OpenRecordset("setting", dbOpenDynaset)
            
            'バージョン情報を書き込む
            With rs
              .FindFirst "ID=1"
              .Edit
              !バージョン = newverhit
              .Update
            End With
            
            'DB接続解除
            Set db = Nothing
            Set rs = Nothing
                        
            '続けて既存ファイルを起動する
            stAppName = accesspath & " /runtime " & Chr(34) & appfilepath & Chr(34)
            Call Shell(stAppName, 1)
            DoCmd.Quit
            
        Else
            '通常通り既存ファイルを起動する
            stAppName = accesspath & " /runtime " & Chr(34) & appfilepath & Chr(34)
            Call Shell(stAppName, 1)
            DoCmd.Quit
        End If
    
    Else
        'アップデートがない場合の処理
        '通常通り既存ファイルを起動する
        stAppName = accesspath & " /runtime " & Chr(34) & appfilepath & Chr(34)
        Call Shell(stAppName, 1)
        DoCmd.Quit
    End If
    
End Function

'ZIPファイルを解凍するルーチン
Function zipmelt(archivepath As Variant) As Variant
    '変数を宣言
    Dim sh As Object
    Dim taropath As String
    Dim desktoppath As Variant
    
    '変数の初期化
    taropath = CurrentProject.path & "\testdatabase.accdb"
    
    'ファイルの有無を調べ、ある場合には削除する
    Dim oFs As Scripting.FileSystemObject
    Set oFs = New Scripting.FileSystemObject
    
    If IsNull(taropath) Then
    Else
        If oFs.FileExists(taropath) Then
            Kill taropath
        End If
    End If
    
    'OS標準機能でファイル解凍ルーチン
    Set sh = CreateObject("Shell.Application")
    desktoppath = CurrentProject.path
    sh.Namespace(desktoppath).CopyHere sh.Namespace(archivepath).Items
    
    '値を返す
    zipmelt = 1
    
End Function

'起動時にウィンドウを最小化する為のコード
Public Function WindowMinimize() As Boolean
    Dim result As LongPtr
    result = ShowWindow(Application.hWndAccessApp, SW_SHOWMINIMIZED)
    DoCmd.OpenForm ("startup")
    WindowMinimized = True
End Function

• start.accdbは起動時にAutoexecマクロを実行するように仕込んであります。
• また、start.accdb自体は起動時に最小化され表示されないようにしてあります。
• Autoexecマクロを実行すると、ウィンドウは最小化され、updateexecプロシージャを実行します。
• 本プログラムは、Microsoft Scripting RuntimeおよびMicrosoft XML v6.0を参照設定で追加しています。
• start.accdbのsettingにあるバージョンとver.xmlに入ってるバージョン情報を比較し、後者が大きい場合にはzipファイルをダウンロードし、zipmeltで解凍しtest.accdbを上書きします。
• アップデートがない場合には、通常どおり、testdatabase.accdbが起動します。
• Windows APIとしてURLDownloadToFileおよびShowWindowの２つを呼び出すようDLLの呼び出しを冒頭に追加しています。
• 通常通り起動（もしくはアップデートをキャンセル時）すると、v1.5のフォームが表示され、アップデートされた場合にはv2.0のフォームが表示されるようになっています。
• OS標準機能でZIPを解凍してるので、この機能はWindows7以上での動作要件となります。

図：アップデータがあるとメッセージが出る仕組み

図：通常はこのフォームが表示。アプデすると中身が変わる

実行結果

実際にstart.accdbを起動してみましょう。

すると、ウェブ上のver.xmlを読み取り、バージョン比較後、アップデートの実行をするとver.xml内に記述されたファイルをダウンロード。その後ZIP解凍し、プログラム本体であるtestdatabase.accdbを起動して完了という手順になります。

アップデート実行後、start.accdbのsettingテーブルには最新のバージョンが書き込まれ、次回起動時のバージョン比較にまた利用されるようになっています。プログラム本体であるtestdatabase.accdbにアップデートルーチンを書いてしまうと、起動している為上書きができないため、このstart.accdbとの二段構えに構成しているのがポイントです。

※再度start.accdbを起動しても最新版なのでアップデートの画面は出ず、通常通りtestdatabase.accdbが起動するようになります。

図：無事にVersion 2.0へアップデートされた。