Accessでデジカメ写真と動画を撮影日ごとに振り分ける その2

その1からの続きです。

Accessでデジカメ写真と動画を撮影日ごとに振り分ける その1

今年の夏もとんでもなく暑い日々が続きましたが、8月末からの大雨の連続が強引に秋をつれてきた感じがする今日この頃です。さて、夏休みでデジカメのSDカードは写真でいっぱいです。そろそろPCに取り込んで、SDカードを空にしないといけません。今日は...

waq3-travelog.com

2017.04.19

ACCESSを起動すると、フォーム「MENU」が起動します。

左上のボタン「btn_コピー元」には、以下のコードをクリック時のイベントに割り当てています。

Private Sub btn_コピー元_Click()

Me.txt_コピー元 = ""
Me.txt_コピー元 = GetTransfer
End Sub

これにより、「btn_コピー元」をクリックすると、フォルダ参照ダイアログが表示されます。

ダイアログのOKをクリックすると、「txt_コピー元」にコピー元フォルダのパスがセットされます。

ここでは、写真を保存したSDカードをEドライブとして設定しています。

Eドライブに10個のjpegファイル（写真）と1個のmovファイル（動画）を入れてあります。

写真は、2013/8/1から2013/8/10までに1枚ずつ撮影したもの。動画ファイルは、2013/8/7に撮影したものです。

次に、「btn_コピー先」をクリックすると、同様にフォルダ参照ダイアログが表示されるので、コピー先のフォルダを指定します。「btn_コピー元」には、同様に以下のコードをクリック時のイベントに割り当てています。

Private Sub btn_コピー先_Click()

Me.txt_コピー先 = ""
Me.txt_コピー先 = GetTransfer
End Sub

出力先は、デスクトップに作成した「IMG」フォルダとします。

フォームの「btn_コピー実行」をクリックするとコピー先として指定したフォルダに、ファイル作成日を名前にしたフォルダを作成してコピーを実行します。コードは、以下のとおりです。

Dim db As DAO.Database
Dim rst As DAO.Recordset
Dim strSQL As String

Dim FSO As Object
Dim myPath, MyName, strTgTPATH, strTgTFileNM As String
Dim FSO_DateCreated  As String
Dim LP_CNT As Long

Private Sub Form_Load()

Me.txt_コピー元 = "E:\"
Set db = CurrentDb
strSQL = "delete * from 変換"
db.Execute strSQL
End Sub 

Private Sub btn_コピー実行_Click()

Set db = CurrentDb
strSQL = "delete * from 変換"
db.Execute strSQL

' パスを設定します。
myPath = Me.txt_コピー元 & "*.*"
MyName = Dir(myPath, vbNormal)
strTgTPATH = Me.txt_コピー先

Set FSO = CreateObject("Scripting.FileSystemObject")
LP_CNT = 1
Do While MyName <> ""    ' ループを開始します。
    
    myPath = Replace(myPath, "*.*", "", , , vbTextCompare)
    FSO_DateCreated = FSO.GetFile(myPath & "" & MyName).DateCreated
    
    strSQL = "insert into 変換 (コピー元パス,ファイル名,ファイル作成日時,コピー先パス) " & _
            "values('" & myPath & "','" & MyName & "',#" & CDate(FSO_DateCreated) & "#,'" & strTgTPATH & "" & Format(CDate(FSO_DateCreated), "yyyy_mmdd") & "" & "' )"
    db.Execute strSQL
    
    MyName = Dir         ' 次のファイル名を返します。
    LP_CNT = LP_CNT + 1
Loop

strSQL = "select * from フォルダ名"

Set rst = db.OpenRecordset(strSQL)
If rst.RecordCount <> 0 Then
Do
    If Dir$(strTgTPATH & "" & rst!名前, vbDirectory) = "" Then
    
        MkDir (strTgTPATH & "" & rst!名前)
    Else
    
        MsgBox rst!名前 & "フォルダがあります。処理を中止します。"
        rst.Close
        Exit Sub
    End If
    rst.MoveNext
Loop Until rst.EOF = True
End If
rst.Close


strSQL = "select * from 変換"
Set rst = db.OpenRecordset(strSQL)
If rst.RecordCount <> 0 Then
Do
    MyName = rst!ファイル名
    myPath = rst!コピー元パス
    strTgTPATH = rst!コピー先パス
    
    'コピー元
    myPath = myPath & MyName
    
    'コピー先
    strTgTPATH = strTgTPATH & MyName
    
    FileCopy myPath, strTgTPATH

rst.MoveNext
Loop Until rst.EOF = True
End If
rst.Close

MsgBox "コピー完了", vbInformation
End Sub

コピー完了のメッセージが出現したら、正常終了です。IMGフォルダを見てみましょう。

うまくいったようです。

コマンドプロンプトのtreeコマンドでファイル構造を見てみましょう。

treeコマンドとは、ドライブやパスのフォルダ構造を図式表示してくれます。

TREE [ドライブ:][パス] [/F] [/A]

/F 各フォルダのファイル名を表示します。
/A 拡張文字ではなく、ASCII 文字で表示します。

├─2013_0801
│ 0001.JPG
│
├─2013_0802
│ 0002.JPG
│
├─2013_0803
│ 0003.JPG
│
├─2013_0804
│ 0004.JPG
│
├─2013_0805
│ 0005.JPG
│
├─2013_0806
│ 0006.JPG
│
├─2013_0807
│ 0007.JPG
│ M0001.MOV
│
├─2013_0808
│ 0008.JPG
│
├─2013_0809
│ 0009.JPG
│
└─2013_0810
    0010.JPG

撮影日のフォルダへファイルがコピーされました。動画ファイルも2013_0807フォルダへコピーされていますね。成功です。

このACCESS-VBAは、WindowsXP SP3、Access2000、Internet Explorer8で動作確認しています。