VBScriptでMS Accessのdecompile,compile,repair

概要

某所では、ファイルサイズの肥大化を避けるため、accdbに手を入れる度にデコンパイル、コンパイル、および[データベースの最適化と修復]をすることになっている（慣わし・仕来りの類）
毎回手作業でやりたくないので作った。

accdb_optimize.vbs

Dim Excel
Set Excel = WScript.CreateObject("Excel.Application")

Const SHIFT_KEY = &H10
Const CMD = "C:\Windows\System32\cmd.exe"
Const MSACCESS = """C:\Program Files {(}x86{)}\Microsoft Office\Office16\MSACCESS.EXE"" "
Const AAA_DB_PATH     = "C:\aaa.accdb"
Const BBB_DB_PATH     = "C:\bbb.accdb"
Const CCC_DB_PATH     = "C:\ccc.accdb"
Const DDD_DB_PATH     = "C:\ddd.accdb"

Sub API_keybd_event(bVk, bScan, dwFlags, dwExtraInfo)
    Dim strFunction
    Const API_STRING = "CALL(""user32"",""keybd_event"",""JJJJJ"", $1, $2, $3, $4)"
    strFunction = Replace(Replace(Replace(Replace(API_STRING, "$1", bVk), "$2", bScan), "$3", dwFlags), "$4", dwExtraInfo)
    Call Excel.ExecuteExcel4Macro(strFunction)
End Sub

Sub optimize(dbPath)
    Dim WshShell,acApp,ctrl,acForm,i,objExecCmd
    Set WshShell = WScript.CreateObject("WScript.Shell")
    
    WshShell.Run(CMD)
    WScript.Sleep(1000)
    WshShell.SendKeys(MSACCESS & dbPath & " /decompile")

    'Shift on
    Call API_keybd_event(SHIFT_KEY, 0, 1, 0)
    
    'Decompile
    WshShell.SendKeys("{enter}")
    WScript.Sleep(2000)

    'Shift off
    Call API_keybd_event(SHIFT_KEY, 0, 3, 0)
    
    'Compile
    Set acApp = GetObject(dbPath)
    Set ctrl = acApp.VBE.CommandBars.FindControl(,578)
    ctrl.Execute()
    WScript.Sleep(1000)
    
    'Close shutter bar
    Call acApp.DoCmd.SelectObject(acForm, "", True)
    acApp.DoCmd.Minimize()
    WScript.Sleep(1000)
    
    'Close ACCDB
    WshShell.SendKeys("%{F4}")
    WScript.Sleep(3000)

    'Just in case(shift off)
    Call API_keybd_event(SHIFT_KEY, 0, 3, 0)

    'Compact and repair database
    WshShell.AppActivate(CMD)
    WshShell.SendKeys(MSACCESS & dbPath & " /compact")
    WshShell.SendKeys("{enter}")
    WScript.Sleep(2000)

    'Close CMD
    WshShell.AppActivate(CMD)
    WshShell.SendKeys("exit{enter}")
End Sub

Sub main
    Dim input_no
    input_no = CStr(InputBox("Decompile, compile, compress and repair ACCDB." & vbCrLf & _
                             "Please input the number for target App." & vbCrLf & _
                             vbCrLf & _
                             "1:AAA" & vbCrLf & _
                             "2:BBB" & vbCrLf & _
                             "3:CCC" & vbCrLf & _
                             "4:DDD", _
                             "ACCDB optimization tool"))

    If input_no = "" Then
        exit sub
    Elseif input_no = "1" Then
        optimize(AAA_DB_PATH)
    Elseif input_no = "2" Then
        optimize(BBB_DB_PATH)
    Elseif input_no = "3" Then
        optimize(CCC_DB_PATH)
    Elseif input_no = "4" Then
        optimize(DDD_DB_PATH)
    Else
        Call MsgBox("The menu does not have that number. " & input_no)
        Exit Sub
    End if
    Call MsgBox("Optimization complete.", vbInformation)
End Sub

'execute main procedure
main()

解説

• 処理の完了検知ができないので、所々で適当な秒数sleepしてる。
• Shift押しながらdecompileしないと、スタートアップフォームやマクロが起動してしまうので、Excel経由でWindows APIを使って、Shiftキーを押しっぱなしたことにしている。

所感

• mission-criticalなところでMS Accessをアプリとして使うのはやめたほうがいい気がします...
• Accessでimport/exportを6,000回くらい繰り返すと、謎のエラーで動かなくなる...