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

今年の夏もとんでもなく暑い日々が続きましたが、8月末からの大雨の連続が強引に秋をつれてきた感じがする今日この頃です。

さて、夏休みでデジカメのSDカードは写真でいっぱいです。そろそろPCに取り込んで、SDカードを空にしないといけません。今日は、撮影日ごとに振り分けるACCESSのVBAをご紹介します。

撮影日ごとにフォルダを作って振り分けたい！

和休の場合、デジカメで撮影した写真は、撮影日ごとのフォルダを作成してそこへ保管しています。

たとえば、2013年9月6日に撮影した写真を保管するフォルダ名は、2013_0906です。ファイル名はそのままです。

これまではフリーソフトの「FuriwakeTo」を使用していましたが、静止画（jpegファイル）は振り分けてくれるのですが動画（movファイル）は残ってしまう問題がありました。

そんならACCESSを使用して同様の機能を作り上げてしまえ！ということで、作成しました。

テーブル

テーブル名　変換

フィールドは、コピー元パス（テキスト型 サイズ255）、ファイル名（テキスト型 サイズ255）、ファイル作成日時（日付型）、コピー先パス（テキスト型 サイズ255）

クエリ

クエリ名　フォルダ名

SELECT Format([変換]![ファイル作成日時],”yyyy_mmdd”) AS 名前

FROM 変換

GROUP BY Format([変換]![ファイル作成日時],”yyyy_mmdd”);

フォーム

フォーム名　MENU

フォームにはボタンが3つ、テキストボックスが2つあります。

「コピー元を設定」ボタンの名前はbtn_コピー元

「コピー先を設定」ボタンの名前はbtn_コピー先

「コピー実行」ボタンの名前はbtn_コピー実行

テキストボックスの名前は、「txt_コピー元」と「txt_コピー先」。

マクロ

マクロ名　autoexec

起動時にmenuフォームを立ち上げる設定です。

モジュール

モジュール名　Module1

フォルダ参照ダイアログとデスクトップへのパスを取得する関数を入れてあります。

どちらもネット上で見つけたコードそのままです。

Module1の中身

Option Compare Database
Option Explicit

Type BROWSEINFO

    hWndOwner As Long
    pidlRoot As Long
    pszDisplayName As String
    lpszTitle As String
    ulFlags As Long
    lpfn As Long
    lParam As Long
    iImage As Long
  
End Type

Declare Function SHBrowseForFolder Lib "SHELL32" (lpbi As BROWSEINFO) As Long
Declare Function SHGetPathFromIDList Lib "SHELL32" _
                        (ByVal pIDL As Long, ByVal pszPath As String) As Long

Public Function GetBrowseFolder(strMsg As String) As String
'フォルダ参照ダイアログを表示し選択されたフォルダ名を返します。
'引数 strMsg : ダイアログに表示するメッセージ(例:"フォルダを指定して下さい")
'[キャンセル]ボタンやESCキーが押された場合は長さゼロ("")の文字列を返します。

Dim udtBrowseInfo As BROWSEINFO
Const cMaxPathLen = 256
Dim strBuffer As String * cMaxPathLen
Dim strPathBuffer As String * cMaxPathLen
Dim strRetPath As String
Dim lngRet As Long

'BROWSEINFO構造体を定義します
With udtBrowseInfo
.hWndOwner = Application.hWndAccessApp
.pidlRoot = 0
.pszDisplayName = strBuffer
.lpszTitle = strMsg & vbNullChar
.ulFlags = 1
.lpfn = 0
.lParam = 0
.iImage = 0
End With

GetBrowseFolder = "" '返り値の初期設定を行います

lngRet = SHBrowseForFolder(udtBrowseInfo) 'フォルダ参照ダイアログを表示します

If lngRet <> 0 Then 'API関数の返り値をチェックします

If SHGetPathFromIDList(lngRet, strPathBuffer) <> 0 Then
'返り値にフォルダ名をセットします
GetBrowseFolder = Left(strPathBuffer, InStr(strPathBuffer, vbNullChar) - 1)
End If

End If

End Function

Function GetTransfer()

    Dim strFolder As String
  
    'フォルダの参照ダイアログを表示します
    strFolder = GetBrowseFolder("フォルダを指定して下さい。")
  
    If Len(strFolder) > 0 Then
    
        If Right$(strFolder, 1) <> "" Then 
            'フォルダが選択された場合
            strFolder = strFolder
        End If
        
    GetTransfer = strFolder
   
    Else
        
        MsgBox "キャンセルされました。", , "管理者"
        'キャンセルされたときはアクションなし
        
    End If

End Function

Function myDeskTopPath()
    ' 実行時の デスクトップパス取得
    Dim MyWSH  As Object
    Set MyWSH = CreateObject("WScript.Shell")
    myDeskTopPath = MyWSH.SpecialFolders("Desktop")
    Set MyWSH = Nothing
End Function

その2へ続く

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

その1からの続きです。 ACCESSを起動すると、フォーム「MENU」が起動します。 左上のボタン「btn_コピー元」には、以下のコードをクリック時のイベントに割り当てています。 Private Sub btn_コピー元_Click() M...

waq3-travelog.com

2017.04.20