VBScript ドラッグ＆ドロップでファイルをAccessDBに登録する仕組み

PCのファイルは通常「フォルダ分け」によって整理される。
ところがフォルダ―ツリーを使った整理は実際のところそんなにうまく機能しない。
なぜなら、コウモリ問題が存在するから。

コウモリ問題とは、物事を単一の基準で分類していくと両方の基準に合致した場合に詰む事象を言う。
※イソップ寓話の「卑怯なコウモリ」が由来だとのこと。

例えばプロジェクトAフォルダと、手順書フォルダが別の場所にあり、プロジェクトAに関する手順書をどちらに入れるべきかといったものが代表的。片方にだけ入れると反対側を探して時間を浪費するリスクがあり、両方に入れると二重管理で内容が枝分かれするリスクがある。

この問題に対する解決策の一つとして、タグ付けによる管理がある。タグは一つのファイルに複数付けることができ、関連するファイル群を瞬時にリストアップできる。

一応Windowsのファイルにもタグをつける仕組みはあるけれどちょっと面倒なのでVBScriptとAccessを使って簡易システム化してみた。
といっても登録部分はAccessの機能を殆ど使わず、VBScriptからADOで登録する形式だ。

作成するシステムの解説

スクリプトにファイルをドラッグ＆ドロップすると用途や入手方法、より適切な新しいファイル名、タグを尋ね、それらを入力するとAccessDB上に登録される。その際に一意の番号を発行してファイル名の先頭に付加する。
特に人からもらったファイルはファイル名を変えてしまうと「あのファイル」と言われたときに分からなくなるけど、自分の言葉で適切にファイル名を付けておかないとそれはそれで分からなくなるので、新旧名称をDBに登録できるようにした。
AccessDB上にファイルを添付してしまうことも技術的には可能と思われるが、今回はそれはせず、保管場所は一旦元の場所を保持する仕組みにしている。

Accessファイルの準備

FileDB.accdbというファイル名で適当な場所に作成。
私の場合は "C:\Users\thom\Documents\FileDB.accdb" とした。

FileMasterというテーブルを作り、以下のフィールドを作成。

VBScriptのコード

コードは以下の通り。RegisterFiles.vbsというファイル名にした。自分のOSが64Bitなので32Bitで動作を試してないんだけれど、基本的にはこのままで動くはず。動かなければ64Bit対策と書かれた部分をバッサリ削除したら動くかもしれない。

'64bit対策ここから---------->
Dim Sh 'As WScript.Shell
Set Sh = CreateObject("WScript.Shell")

Dim Processor: Processor = Sh.ExpandEnvironmentStrings("%PROCESSOR_ARCHITECTURE%")
Dim Systemroot: Systemroot = Sh.ExpandEnvironmentStrings("%SYSTEMROOT%")

Function Quote(x) 'As String
    Quote = """" & x & """"
End Function

Function ArgsToString() 'As String
    Dim ret 'As String
    If WScript.Arguments.Count > 0 Then
        For Each a In WScript.Arguments
            ret = ret & Quote(a) & " "
        Next
        ret = " " & Left(ret, Len(ret) - 1)
    End If
    ArgsToString = ret
End Function

If Processor = "AMD64" Then
    Sh.Run Quote(Systemroot & "\SysWOW64\wscript.exe") _
        & " " & Quote(WScript.ScriptFullName) & ArgsToString
    WScript.Quit
End If
'<----------64bit対策ここまで

Dim FSO 'As Scripting.FileSystemObject
Set FSO = CreateObject("Scripting.FileSystemObject")

Call Main

Sub Main()
    Dim dic 'As Scripting.Dictionary
    Set dic = CreateObject("Scripting.Dictionary")
    For Each arg In WScript.Arguments
        Set f = New FileInfo
        f.FullPath = arg
        f.Init
        dic.Add arg, f
    Next
    
    For Each k In dic.Keys
        AddDB dic(k)
    Next
    WScript.Echo "登録が完了しました。"
End Sub

Sub AddDB(o)
    Const dbFile = "C:\Users\thom\Documents\FileDB.accdb"
    Set cn = CreateObject("ADODB.Connection")
    cn.Open "Driver={Microsoft Access Driver (*.mdb, *.accdb)}; DBQ=" & dbFile & ";"
    Set rs = CreateObject("ADODB.Recordset")
    Const adOpenKeyset = 1
    Const adLockOptimistic = 3
    rs.Open "FileMaster", cn, adOpenKeyset, adLockOptimistic
    rs.AddNew
    rs.Update    '←この後参照するAutoNumber型のrs.Fields(0)を確定させるために一度更新をかける。
    o.FileNumber = rs.Fields(0)
    rs.Fields(1) = o.OriginalFileName
    rs.Fields(2) = o.GetFrom
    rs.Fields(3) = o.GetBy
    rs.Fields(4) = o.Description
    rs.Fields(6) = Now()
    o.ChangeFileName
    rs.Fields(5) = o.NewFileName
    rs.Fields(7) = o.Tag
    rs.Update
    rs.Close: cn.Close
End Sub

Class FileInfo
    Public FullPath
    Public OriginalFileName
    Public Description
    Public GetFrom
    Public GetBy
    Public NewFileName
    Public FileNumber
    Public Tag
    Sub Init()
        OriginalFileName = FSO.GetFileName(FullPath)
        GetFrom = InputBox("「" & OriginalFileName & "」の提供者名を入力してください。")
        GetBy = InputBox("「" & OriginalFileName & "」の入手方法を入力してください。")
        NewFileName = InputBox("「" & OriginalFileName & "」に、より適切な新規ファイル名を入力してください。")
        NewFileName = NewFileName & "." & FSO.GetExtensionName(FullPath)
        Description = InputBox("「" & NewFileName & "」についての説明を入力してください。")
        Tag = InputBox("「" & NewFileName & "」に付けるタグを入力してください。")
    End Sub
    Sub ChangeFileName()
        NewFileName = "F" & Right("000000" & FileNumber, 6) & "_" & NewFileName
        FSO.MoveFile FullPath, FSO.BuildPath(FSO.GetParentFolderName(FullPath), NewFileName)
    End Sub
End Class

試しにtest.gifというファイルをドロップすると諸々の質問がなされ、それに答えていくとDBに登録される。そしてファイル名も新しくなる。

64bit対策について

今回一番苦労したのが64bit対策。StackOverflowで解決策を見つけたんだけれど、勘違いしてドはまりした。
64bitOSではSystem32フォルダに64bit用のバイナリが配置されていて、SysWOW64フォルダに32ビット互換用のバイナリが配置されているということらしい。てっきりSystem32が32Bit、SysWOW64が64bitだと思ってたのでここで3時間ほどロス。
恐らく諸々の互換性のために標準のシステムフォルダはSystem32で固定化しているのだと思う。

環境変数の%PROCESSOR_ARCHITECTURE%を確認すれば32bit環境か64bit環境かが分かるので、64bitだったらSysWOW64フォルダ内の32bit版wscriptを呼び出す。
ちなみに%PROCESSOR_ARCHITECTURE%は64bit版WindowsはAMD64となっている。AMDのCPUはもちろん、IntelのCPUでもAMD64。ややこしいけど、CPUアーキテクチャ名なので仕方がない。