Accessファイルをオンライン更新するテクニック
Accessは小さなデータベースで、VBAが使えることから非常に多くの現場のシステム構築として利用されてきました。しかし、デメリットとして、アップデートをした場合にそのファイルの配布方法とアップデート方法に於いては、非常にアナログな手法が用いられており、管理するのが大変面倒ということは言われ続けてきました。
最近のアプリケーションのように、オンライン経由でアップデート通知や自動ダウンロード、サイレントアップデートなどができれば、このデメリットも大きく克服ができるのではと考え、今回自分が現場のシステムで使ってるオンラインアップデート方法について公開してみたいと思います。
リンク
今回使用するファイル
仕組み
今回のこの仕組はオンラインといっても、ファイルサーバーでも良いですし、どこかのクラウド上で直リンクでダウンロードできるならば使える仕組みです。今回使用するファイルのうち
- アップデート情報の入ったXMLファイル
- アップデートする本体の入ったZIPファイル
の２つはオンライン上のどこかに配置しなければなりません。今回は、https://officeforest.org/update/以下にこの２つのファイルを保存してあります。
その後、実際にアップデートする場合には、以下の手順でファイルを差し替えます。
- XMLファイルのverの項目を最新のバージョン数値に書き換え、サーバ上のファイルを差し替える
- そのバージョンに該当するファイルをupdate.zipとして圧縮し、サーバ上のファイルを差し替える
配布済みのプログラムは最初に起動させるのは、start.accdb（一番最初に起動させるデータベースファイル）としプログラムであるtestdatabase.accdb（プログラム本体のファイル）は直接は起動させません。start.accdbがアップデート情報を読み取り、更新後にtest.accdbを起動する仕組みになっている為です。
※現在のプログラム本体のファイルのバージョン情報は、start.accdbのsettingテーブルに入っています。
図：Webサーバ上にファイルを配置してみた
ソースコード
XMLファイルのコード
|
1 2 3 4 5 6 7 |
<?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起動時に実行するコード
|
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 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 |
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へアップデートされた。
vbaは初心者ですがAccessのデータベースをオンラインで自動的にアップデートをしたいと考えてたところ、この記事を見つけました。
参考にしなが実際コードを実行すると行No.82のところ実行時エラー91でオブジェクト変数またはwithブロック変数が設定されていませんのエラーが出てその先に進みませんでした。
もしよろしければエラーの対策などがありましたは教え下さいm(_ _)m
てつくん様
officeの杜管理人です。
参照設定で、Microsoft XML v6.0は追加されていますか？ここでコケるということは、だいたい参照設定が入っていないケースが多いのですが。
管理人様
お返事ありがとうございます。
参照設定にてMicrosoft XML V6.0にチェックは入っております。
その他は
Visual Basic For Application
Microsoft Access 16.0 Object Library
OLE Automation
Microsoft Scripting Runtime
Microsoft Office 16.0 Access database engine
にもチェックは入っております。
実行した際、エラー箇所にカーソルあてるとXmlNol = Nothing と表示されます。
この辺りが気になっております
知識不足ですみませんm(_ _)m
管理人様
何度も申し訳ありません。
色々とチェックしながら進めていたところ、エラーも出ずにアップデートをする事ができました。
原因は私です。。。
サーバーにおいたxmlファイルとzipファイルに直リンクの許可をしたところ、無事に動きました。
ご迷惑お掛けしました。
てつくん様
officeの杜管理人です。
VBAのエラーメッセージは酷くわかりにくいのが多いので仕方ないです。古い言語なので。
とりあえず、動いてよかったです。