Harigami

Enter code which you want to share

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

'処理時間の計測-----------------------------------------------------------------------------------
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 "*.xlsm" Or f1.Name Like "*.XLSM" 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

Select language

Check to hide your code on timeline Preferences