FSOで写真の更新日時を調べる。スマホの写真をまとめたい。

FileSysytemObjectを使って、写真の作成、更新、アクセス日時を調べる

過去記事で、PowerShellを使って写真の作成日時を元にフォルダを作成し格納するというShellを作ったことがありました。

bimori466-1.hatenablog.com

ExcelにはＦＳＯがあり、「作成、更新、アクセス日時」を調べることができるので同じようなものができることに気づき、作ってみました。

PowerShellは書き方が違うので、慣れないためExcelで作った方が馴染みやすいと思い作ってみました。

写真が増えたのは、子どもの写真を撮りすぎて整理の収集がつかなくなったからです。
アルバム作る時に「年、月」で整理していれば、成長の過程がわかりやすいかなという感じです。

子どもの将来のためにも整理してあげよう、という多少の親心をみせます。

目次
　１　閲覧対象者
　２　得られる効果
　３　設計
　４　ＶＢＡの処理を解説
　５　作ってみての感想
　６　使ってみたい方（noteのリンク）

１　閲覧対象者

大量の写真を作成日時で「年、月」ごとのフォルダにざっくり仕分けしたい人

２　得られる効果

大量の写真ファイルが、

「年、月」ごとに仕分けされて、格納される。

３　設計

２のフォルダに写真を格納する。
１のエクセルマクロ実行。
３のフォルダに「年、月」ごとに写真が格納される。

＊２，３のフォルダが１のエクセルのPATHになければ、２，３フォルダを作成する（Workbook_Open）。

４　ＶＢＡの処理を解説

ＦＳＯで、作成、更新、アクセス日時」を調べる。

まずは、写真の「作成、更新、アクセス日時」をMsgboxに表示してみます。

結果

処理コード

Sub 写真の最終日時を取得()

Dim fso As Object
Set fso = CreateObject("scripting.filesystemobject")
Set f = fso.GetFile("ファイルPATH\＊.jpg")

MsgBox "  作  成  日  時   ：" & FileDateTime("ファイルPATH\＊.jpg") & vbCrLf & _
       "最終更新日時　：" & f.DateLastModified & vbCrLf & _
       "最終アクセス日時：" & f.DateLastAccessed

picture_date = FileDateTime("ファイルPATH\＊.jpg"")
picture_year = Year(picture_date)
picture_month = Month(picture_date)
picture_day = Day(picture_date)
picture_hour = Hour(picture_date)
picture_minute = Minute(picture_date)
picture_second = Second(picture_date)


Set f = Nothing


End Sub

解説

作　成　日　時　　→　FileDateTime("ファイルPATH\＊.jpg") 　＊ＦＳＯは関係ない。
最終更新日時　　　→　f.DateLastModified
最終アクセス日時　→　f.DateLastAccessed

読んでそのままで、わかりやすいです。
Msgboxの下のコードは、作成日時から「年、月、日、時、分、秒」が取得できることを表しています。
つまり、ここの「年、月」で条件分岐すればフォルダーを作成し写真を格納する処理が作れるということです。

本題の写真を「年、月」ごとに格納するマクロ

ＦＳＯで作成日時の「年、月」から、フォルダがあるか調べる。
フォルダがあれば、写真をそのフォルダに移動する。
フォルダがなければ、フォルダを作って写真をそのフォルダに移動する。

これだけです。

noteにはフォルダがアップできなかったので、このExcelを開いたら、同じPathにフォルダを作成するようにしました。（ThisWorkBookに処理記述）。

ＶＢＡのコード

標準ジュール　年月別にフォルダを作成

Sub 年月別にフォルダを作成()

'処理時間の計測-----------------------------------------------------------------------------------
Dim startTime As Double
Dim endTime As Double
Dim processTime As Double

startTime = Timer
'__________________________________________________________________________________________________


Dim targetFolder As String
Dim loadFolder As String

targetFolder = ThisWorkbook.Path & "\" & "写真を仕分けて格納"
loadFolder = ThisWorkbook.Path & "\" & "処理対象写真を格納する"


Dim fso_lord, fso_traget As Object
Set fso_lord = CreateObject("scripting.filesystemobject")
Set fso_traget = CreateObject("scripting.filesystemobject")

Set f = fso_lord.GetFolder(loadFolder)
Set f2 = fso_traget.GetFolder(targetFolder)
Set fc = f.Files


'ファイル数が０なら処理終了。
If fc.Count = 0 Then MsgBox "対象ファイルなし": Exit Sub


'主処理
For Each f1 In fc

    '.jpgを処理。
    If f1.Name Like "*.jpg" Or f1.Name Like "*.JPG" Then
        '年、月を取得する。
        picture_date = FileDateTime(f1)
        picture_year = Year(picture_date)
        picture_month = Month(picture_date)
        FolderName = picture_year & "年" & picture_month & "月"
        SerchFolder = targetFolder & "\" & FolderName
        
        'フォルダが存在するか調べる
        If fso_traget.FolderExists(SerchFolder) Then
            '存在する場合は格納処理
            fso_lord.MoveFile f1, SerchFolder & "\"
            
        Else
            '存在しない場合は、フォルダを作って格納処理

            'フォルダ作成
            fso_traget.createfolder SerchFolder
            
            'ファイルを格納
            fso_lord.MoveFile f1, SerchFolder & "\"
            
        End If
        
    End If
Next f1


'処理時間の計測-----------------------------------------------------------------------------------
endTime = Timer
processTime = endTime - startTime

MsgBox "end 処理時間＝" & Round(processTime / 60, 0) & "分" & Round(processTime Mod 60, 0) & "秒"
'__________________________________________________________________________________________________


End Sub

ThisWorkBook　フォルダを作成するコード

Private Sub Workbook_Open()

Dim fso As Object
Set fso = CreateObject("scripting.filesystemobject")

SerchFolserPath = ThisWorkbook.Path
Serch1 = "処理対象写真を格納する"
Serch2 = "写真を仕分けて格納"

'ファルダが存在するか調べる

If fso.FolderExists(SerchFolserPath & "\" & Serch1) Then
    'フォルダ有、処理なし。
Else
    'フォルダなし、フォルダを作る
    fso.createfolder SerchFolserPath & "\" & Serch1
    MsgBox "フォルダ：「処理対象写真を格納する」を作成しました。"
End If


If fso.FolderExists(SerchFolserPath & "\" & Serch2) Then
    'フォルダ有、処理なし。
Else
    'フォルダなし、フォルダを作る
    fso.createfolder SerchFolserPath & "\" & Serch2
    MsgBox "フォルダ：「写真を仕分けて格納」を作成しました。"
End If

    
End Sub

５　作ってみての感想

意外と簡単にできました。Pwershellはあんまり使わないので、VBAで作った方が親しみがわきます。
約２００枚の写真を１３秒くらいで仕分けできました。割と早いので、処理速度は問題なしかと。

６　使ってみたい方（noteのリンク）

noteから無料でダウンロードできます。
興味のある方は、お試しください。
note.com