夜なべをして手袋作らずにプログラムを作る

コンピュータ

デジカメで撮影した画像ファイルや動画ファイルを、SDカードからPCのハードディスクの自動的に生成した撮影日別のフォルダに、根こそぎコピーするスクリプトを作った。以前から、Epsonのプリンタ付属のソフト「Photo Quicker」を作っていたが、対象が画像ファイルだけなので、動画ファイルは別途手作業でコピーしていた。フリーソフトで適当なものを探したが、いま一つぴったりのものがない。マイクロソフトの機能を使うとファイル名を勝手に書き換えてしまう。なぜそういう余計なことをするのかわからない。Picasaを使うとできそうな気もするが、以前試したときはできなかった。

問題は、SDカード内でファイル名が重複していた場合だが、上書きしないようにして、ログにその旨表示してチェックができるようにした。通常のデジタルカメラでの撮影では発生しない。本来はJPEGやAVIのファイルヘッダに格納されている「撮影日」でフォルダ分類したいが、ObjFile の属性としては取得できなかったので、更新日 ObjFile.DateModified を使っている。いくつかのフォルダの画像で確認したが、基本的に撮影日と更新日は一致している。PC上で編集すると違ってくるが、このスクリプトはあくまでSDカードからPCのハードディスクへコピーする目的のものなので、割り切ることにした。また、一部のフォルダでサブフォルダの再帰的探索がうまくいってない現象が出たが、あるフォルダに限定した動作なので、そのフォルダ自体に問題がありそうだ。もう少し調べてみよう。

バッチファイルとvbsファイルを組み合わせて使う。バッチファイル内の、環境変数を書き換えれば、コピー元とコピー先を自由に変更できるようにした。
なお、スクリプト中の関数 lngCnLen() は、Yoshio Kanaya さんのホームページの素 screenshot のものをそのまま使わせていただいてる。ありがたや。


バッチファイル c2fbd.bat

@echo off
: C2FBD - Copy to Folders by Date
: 2007/06/29 Version 0.1 

:*** コピー元
set constantSrc=E:\

:*** コピー先
set constantDst=C:\Pictures

:*** ログファイル
set constantLog=.\C2FBD.log

echo  START  / %date% %time% >>%constantLog%
c2fbd.vbs                    >>%constantLog%
echo  FINISH / %date% %time% >>%constantLog%

vbsファイル c2fbd.vbs

public constantDst
public constantSrc

Set objShell = WScript.CreateObject("WScript.Shell")

constantDst = objShell.ExpandEnvironmentStrings("%constantDst%")
constantSrc  = objShell.ExpandEnvironmentStrings("%constantSrc%")

Wscript.Echo " Src    / " & constantSrc
Wscript.Echo " Dst    / " & constantDst

Sub CopyAll(objFolder)

  For Each objFile In objFolder.Files

      strDest = constantDst
      strDest = strDest & "\" & mid(objFile.DateLastModified ,1,4)
      strDest = strDest & "\" & mid(objFile.DateLastModified ,1,4)
      strDest = StrDest & "." & mid(objFile.DateLastModified ,6,2)
      strDest = StrDest & "." & mid(objFile.DateLastModified ,9,2)

      if Not objFSO.FolderExists(strDest) Then
        CreateFolder2 objFSO, strDest
      End if

      strCreated =                    mid(objFile.DateLastModified ,1,4)
      strCreated = strCreated & "." & mid(objFile.DateLastModified ,6,2)
      strCreated = strCreated & "." & mid(objFile.DateLastModified ,9,2)

      if Not objFSO.FileExists(StrDest & "\" & objFile.Name) Then
        strDest = StrDest & "\" & objFile.Name
        objFile.Copy(strDest)
        WScript.Echo " COMPLT / " & strCreated & " / " & objFile.Name & space(40 - lngCnLen(objFile.Name)) & " <== " & objFile.ParentFolder.Path
      else
        strDest = StrDest & "\" & objFile.Name
        WScript.Echo "*EXISTS / " & strCreated & " / " & objFile.Name & space(40 - lngCnLen(objFile.Name)) & " <== " & objFile.ParentFolder.Path
      End if


  Next
  ' 再帰的にサブフォルダのreadonly属性を解除
  For Each objSubFolder In objFolder.SubFolders
      CopyAll(objSubFolder)
  Next
End Sub

Sub CreateFolder2(objFSO, strFolder)
  strParent = objFSO.GetParentFolderName(strFolder)
  If Not objFSO.FolderExists(strParent) Then
    CreateFolder2 objFSO, strParent
  End If
  objFSO.CreateFolder(strFolder)
End Sub

Function lngCnLen(strVal) 
     Dim i, strChr 
     lngCnLen = 0 
     If Trim(strVal) <> "" Then 
          For i = 1 To Len(strVal) 
               strChr = Mid(strVal, i, 1) 
               '２バイト文字は＋２ 
               If (Asc(strChr) And &HFF00) <> 0 Then 
                    lngCnLen = lngCnLen + 2 
               Else 
                    lngCnLen = lngCnLen + 1 
               End If 
          Next 
     End If 
End Function 

Set objFSO = WScript.CreateObject("Scripting.FileSystemObject")
Set objFolder = objFSO.GetFolder(constantSrc)
CopyAll(objFolder)