ざっくり説明
①ユーザーに起動用VBSを配布（ショートカットの方が何かと楽かも）
②起動用VBSからデータベースを実行→デスクトップに本体がコピーされる
③データベースを閉じる時に削除用VBSが実行され、コピーされた本体が削除される
作り方
①サーバーからローカルへ本体をコピーするVBSを作成
↓のコードをメモ帳（.txt）に入れて拡張子を.vbsにして、文字コードを「UTF-16 LE」にして保存。
データベースが開かれているかどうか確認し（laccdbの有無）、開かれていたら二重起動しないように処理終了。開かれていなければ起動する。
強制終了でロックファイルが残った場合でも開けるように対応。
On Error Resume Next
Dim WS, FSO, CopyPath, CopyFileName, PastePath, objAcc, lac
Set WS = CreateObject("WScript.Shell")
Set FSO = WScript.CreateObject("Scripting.FileSystemObject")
CopyPath = "データベースを置いている場所のフルパス" & "\" 'エクスプローラで拾えるパスに\が付いてないので後付け
CopyFileName = "コピーするデータベース本体の名前.accde"
PastePath = WS.SpecialFolders("Desktop") & "\" 'コピー先
DialogTitle = "データベース名" 'Msgboxのタイトルで使う
'①データベースの名前から拡張子を除く→laccdbを付ける
lac = Left(CopyFileName, Len(CopyFileName) - 5) & "laccdb"
'②デスクトップにあるlaccdbの状態（データベースが開かれているか、強制終了したものが残っているだけか）確認
'データベースが開かれてlaccdbが存在する場合はリネーム処理でエラー70が出るのでそれを拾う
'laccdbがない場合はエラー53が出るが拾わずに無視
FSO.GetFile(PastePath & lac).Name = "1" & lac '「1データベース名.laccdb」にする
If Err.Number = 70 Then
'貼り付け先で開かれていたらコピーしない
MsgBox "システムが開かれているためコピーできません。" & vbCrLf & "システムを終了してからやり直してください。", , DialogTitle
WScript.Quit
Else
FSO.GetFile(PastePath & "1" & lac).Delete 'リネームした居残りlaccdbを削除
'コピー
FSO.CopyFile CopyPath & CopyFileName, PastePath
'起動
'CreateObjectでAccessを作成して開こうとするとエラーが出る端末があるのでWS.Runを使用
Return = WS.Run("MSACCESS.EXE " & PastePath & CopyFileName, 3, False) 'Accessを最大化して開く
End If
②ローカルにコピーした本体を削除するVBSを作成
自分で設置したコマンドボタンのClickか、フォームのUnloadでVBSを呼び出す。
↓のコードをメモ帳（.txt）に入れて拡張子を.vbsにして、文字コードを「UTF-16 LE」にして保存
データベースを終了させてコピー先から削除する。
laccdbが消える時間は一定ではないので、消えるまで待機→消えたらデータベース削除。
Dim WS, FSO, CopyFileName, PastePath, objAcc
Set WS = CreateObject("WScript.Shell")
Set FSO = WScript.CreateObject("Scripting.FileSystemObject")
CopyFileName = "コピーしたデータベース本体の名前.accde"
PastePath = WS.SpecialFolders("Desktop") & "\" 'データベースのコピー先
'★Unload内で呼び出す場合はここから下を消す★
'PastePathにデータベースが存在することを確認する
If FSO.FileExists(PastePath & CopyFileName) = True Then
'データベースを開いているか確認し、開いていたら閉じる
'データベース名から拡張子を除く→代わりにlaccdbを付けてデータベースが開かれているかチェック
If FSO.FileExists(PastePath & Left(CopyFileName, Len(CopyFileName) - 5) & "laccdb") = True Then
Set objAcc = GetObject(PastePath & CopyFileName)
objAcc.Quit '閉じる
End If
Else
'PastePathに存在しなければ処理しない
WScript.Quit
End If
'★Unload内で呼び出す場合はここまでを消す★
'削除処理
'Quit後にlaccdbが消えるまでにラグがあるため、Quit直後にDeleteFileが実行されるとエラー（70:書き込みできません）が出る
'laccdbが存在しなくなるまで1秒ずつ処理を休ませる
Do Until FSO.FileExists(PastePath & Left(CopyFileName, Len(CopyFileName) - 5) & "laccdb") = False
WScript.Sleep 1000
Loop
FSO.DeleteFile PastePath & CopyFileName
Set objAcc = Nothing
Set FSO = Nothing
Set WS = Nothing
③本体にコードを入れる
以下のコードを自分で設置したコマンドボタン（閉じる処理）かUnloadに入れる。
Shell "WScript.exe VBSのフルパス"
ボタンを押した時の処理に入れた場合、タスクバーを右クリックしてデータベースを閉じるとVBSの処理を行わない。
Unloadから呼び出す場合は、削除用VBSの「★Unload内で～」の間を消さないとデータベースが再起動→終了という変な動きをする。
