おーぷんにしたいこと

ツイッターの鍵の向こうに置いておきたいものを書きます

フロントエンドデータベースの最新版を利用してもらう方法

ざっくり説明

①ユーザーに起動用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内で~」の間を消さないとデータベースが再起動→終了という変な動きをする。

VBSとタスクスケジューラでデスクトップのバックアップを取る

ついついデスクトップに色々置いて作業してしまうのですが、この前パソコンが起動しなくてヒヤッとしたので、VBSとタスクスケジューラを使ってバックアップを取ることにしました。
ただサーバーにコピーするだけの簡単なものです。

続きを読む

【天穂のサクナヒメ】攻略に役立つ(かもしれない)稲作メモとタイムテーブル

f:id:teali_s:20210201181017p:plain


一応過去の記事で稲作スケジュールを書いていましたが、作業開始日によって全然違うスケジュールになってしまっていたので、改めて調べ直しました。

ちなみに稲作以外のメモはこちら。
hassaku74kg.com

続きを読む

【レビュー】ブギーボードの新しいやつ「Boogie Board BB‐14」とアプリ「Boogie Board SCAN」を使ってみた

f:id:teali_s:20210123134148p:plain

結論:もっと早く買っておけばよかった

ブギーボードを初めて使ったんですが……

  • 芯やインクの減りを気にせずガシガシ書ける
  • 雑に書いた物の処分に困らない


すぐいらなくなるメモ、暇な時の落書きなどなど、「書き起こしたいけど残したくはないもの」って意外とあるんですよね。
だから『書いて即消せる電子メモ』ってこんなに便利なのか!と、見出しの通り「もっと早く買っておけばよかった」と思いました。
「やっぱり消さずに残しておきたいな~」と思ったらスマホで撮影すればいいし、スキャンアプリでデータ化もできる。いい時代ですね。


続きを読む

【スポンサーリンク】