デジカメファイルをコピーする

PC

CASIO EX-Z300には、"Photo Loader with HOT ALBUM"という、デジカメ写真をPCに取り込むツールが付属するのだけど、これが非常に微妙。

EX-Z55に付属していた"Photo Loader"の方がマシ。

基本的にどちらもファイルのExifを読んで撮影日のサブフォルダにファイルをコピーするのだけど、

  • with HOT ALBUMはいちいちコピーするファイルを指定する必要がある。基本的に全選択でよいのだけど、ワンクッション多い
  • with HOT ALBUMはファイル名を勝手に変える

以上のような気に入らない仕様があるのだけど、古いPhoto LoaderではEX-Z300の動画ファイルをコピーしてくれないので、仕方なくwith HOT ALBUMの方を使っていた。

ところが、2台のPCでSyncToyを使って同期しながらしばらく使っていたら、いつのまにか重複するファイルができていた。

幸い、Photo Loader時代のフォルダは残っていたし、EX-Z300のSDカードは購入以来撮り貯めしていて消したファイルは無い。

そこで、with HOT ALBUMでコピーしたファイルは捨てて、Photo Loaderで管理していたファイルをベースに、再度ライブラリを作り直すことにした。


ここで、デジカメファイルをPCにコピーするツールをVBScriptで自作してみた。

希望する仕様は、

  • Exifの撮影日でフォルダを作ってコピーする

これだけ。サムネイルとかいらないし、管理データベースとかいらない。デジカメ付属のツールはアルバム機能とか付加価値を付けたがるが、そんなのPicasaとか使った方がよっぽどよい。


VBScriptからExifを読むのにSImageUtilというCOM object DLLを使った。

http://www.reneris.com/tools/default.asp

ちなみに、Vista 64bitで普通にコマンドプロンプトを実行して、cscriptで.vbsを実行すると64bitのWSHで実行しやがるので、C:\windows\SysWow64\cscript.exe にスクリプトを渡して実行する必要がある。
64bitのWSHから32bitのDLLは利用できない。


以下参考ソース。エラー処理とかログとか省略。
exifのあるファイルはexifから撮影日を読んでいます。exifが取れないファイルはファイルの作成日で代用します。
BASEDIRで指定したフォルダの下位サブフォルダをすべて検索するので、携帯電話のメモリカードにもたぶん対応可能。

Const BASEDIR="K:\"

Const TARGETDIR="F:\test\"

Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objImage = CreateObject("SImageUtil.Image")

Call GetSubItems(BASEDIR)

Private Sub GetSubItems(ByVal szDir)
	Dim objSubFolders
	Dim SubFolder
	
	Dim objFiles
	Dim File
	
	Set objSubFolders = objFSO.GetFolder(szDir)
	
	For Each SubFolder in objSubFolders.SubFolders
		WScript.Echo SubFolder.Path
		Call GetSubItems(SubFolder.Path)
	Next
	
	For Each File in objSubFolders.Files
		WScript.Echo "Source file is :      " & File.Path
		Call CopyPhotos(File.ParentFolder, File.Name, File.DateCreated)
	Next
	
	Set objSubFolders = Nothing
End Sub

Private Sub CopyPhotos(ByVal szFolder, ByVal szFile, ByVal szDate)
	Dim ShotDate

	objImage.OpenImageFile szFolder & "\" & szFile

	ShotDate = objImage.GetExif("Date")
	
	If ShotDate = "" Then
		ShotDate = Replace(Left(szDate, 10), "/", "")
	Else
		ShotDate = Replace(Left(ShotDate, 10), ":", "")
	End If
	
	If Not objFSO.FolderExists(TARGETDIR & ShotDate) Then
		objFSO.CreateFolder(TARGETDIR & ShotDate)
	End If
	
	WScript.Echo "Destination file is : " & TARGETDIR & ShotDate & "\" & szFile
	
	If Not objFSO.FileExists(TARGETDIR & ShotDate & "\" & szFile) Then
		objFSO.CopyFile szFolder & "\" & szFile, TARGETDIR & ShotDate & "\" & szFile, False
		WScript.Echo "1 File copyed."
	End If
	
	objImage.close
End Sub