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

作成するシステムの解説

スクリプトにファイルをドラッグ＆ドロップすると用途や入手方法、より適切な新しいファイル名、タグを尋ね、それらを入力すると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.ShellSet Sh =CreateObject("WScript.Shell")Dim Processor: Processor = Sh.ExpandEnvironmentStrings("%PROCESSOR_ARCHITECTURE%")Dim Systemroot: Systemroot = Sh.ExpandEnvironmentStrings("%SYSTEMROOT%")Function Quote(x)'As String
    Quote =""""& x &""""EndFunctionFunction ArgsToString()'As StringDim ret'As StringIf WScript.Arguments.Count>0ThenForEach a In WScript.Arguments
            ret = ret & Quote(a)&" "Next
        ret =" "&Left(ret,Len(ret)-1)EndIf
    ArgsToString = ret
EndFunctionIf Processor ="AMD64"Then
    Sh.Run Quote(Systemroot &"\SysWOW64\wscript.exe") _&" "& Quote(WScript.ScriptFullName)& ArgsToString
    WScript.QuitEndIf'<----------64bit対策ここまでDim FSO'As Scripting.FileSystemObjectSet FSO =CreateObject("Scripting.FileSystemObject")Call Main

Sub Main()Dim dic'As Scripting.DictionarySet dic =CreateObject("Scripting.Dictionary")ForEach arg In WScript.Arguments
        Set f =New FileInfo
        f.FullPath = arg
        f.Init
        dic.Add arg, f
    NextForEach k In dic.Keys
        AddDB dic(k)Next
    WScript.Echo "登録が完了しました。"EndSubSub 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 =1Const 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.CloseEndSub

Class FileInfo
    Public FullPath
    Public OriginalFileName
    Public Description
    Public GetFrom
    Public GetBy
    Public NewFileName
    Public FileNumber
    PublicTagSub 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 &"」に付けるタグを入力してください。")EndSubSub ChangeFileName()
        NewFileName ="F"&Right("000000"& FileNumber,6)&"_"& NewFileName
        FSO.MoveFile FullPath, FSO.BuildPath(FSO.GetParentFolderName(FullPath), NewFileName)EndSubEnd 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アーキテクチャ名なので仕方がない。