미디어 파일을 날짜별로 분류

사진을 자주 정리하는 것이 아니다보니

날짜별로 폴더 생성하기가 힘들어서 만들어낸 매크로입니다.

기존에 있던 https://dorobo.tistory.com/508 파일은 생성된 일짜가 아니라 마지막 수정날짜를 기준으로 폴더를 만들어서

제가 사용하기엔 안 맞는 부분이 있어서 새로 만들었습니다.

 

사용법이라고 할 것도 없습니다.

1. 모든 미디어(이미지, 동영상 등) 파일을 한 폴더에 모아줍니다.

2. 파일을 실행하면 '추가기능' 탭이 생기면서 '날짜별 분류' 라는 아이콘이 생깁니다.

3. '날짜별 분류' 아이콘을 클릭하면 폴더를 선택하는 대화창이 뜹니다.

4. 미디어 파일을 모아둔 폴더를 선택하면 나머지는 알아서 합니다.

5. 콘텐츠 생성일자를 먼저 기준으로 삼고, 콘텐츠 생성일자가 없으면 수정일자를 기준으로 폴더를 생성합니다.

 

Sub ListMetadata()
 
    Dim objShell As Object
    Dim objFolder As Object
    Dim objItem As Object
    Dim fso As Object
    Dim fileFolder As String
    Dim fileName As String
    Dim filePath As String
 
    Application.ScreenUpdating = False
    Range("A1").CurrentRegion.Clear
    
    ' 폴더 선택
    ChDir ThisWorkbook.Path
    With Application.FileDialog(msoFileDialogFolderPicker)
        .Show
        
        '폴더 선택 안 하면 매크로 종료
        If .SelectedItems.Count = 0 Then
            Exit Sub
        Else
            fileFolder = .SelectedItems(1) & "\"
        End If
    End With
    
    Set objShell = CreateObject("Shell.Application")
    Set objFolder = objShell.Namespace((fileFolder))
    Set fso = CreateObject("Scripting.FileSystemObject")
    
    '폴더 내 파일 순환(폴더에 파일이 없으면 매크로 종료)
    fileName = Dir(fileFolder & "*.*")
    If fileName = "" Then Exit Sub
    
    '찍은날짜 12, 수정한 날짜 3
    '폴더 내 파일이 없을 때까지 불러오기
    '폴더명 설정 예) 2019. 12. 22
    Do While fileName <> ""
        Set objItem = objFolder.ParseName(fileName)
        
        With objFolder
            Select Case Len(.GetDetailsOf(objItem, 12))
                Case Is > 0
                    filePath = CreatedDate(.GetDetailsOf(objItem, 12))
                Case 0
                    filePath = Format(.GetDetailsOf(objItem, 3), "yyyy. m. d")
            End Select
        End With
        
        filePath = fileFolder & filePath & "\"
        
        '날짜로 폴더 만들고 파일 이동
        With fso
            If Not .FolderExists(filePath) Then .CreateFolder filePath
            .MoveFile Source:=fileFolder & fileName, Destination:=filePath
        End With
        
        fileName = Dir
    Loop
    
    Set objItem = Nothing
    Set objFolder = Nothing
    Set objShell = Nothing
    Set fso = Nothing
    
    Application.ScreenUpdating = True
 
End Sub
 
Function CreatedDate(tmp As String) As String
'유령문자 제거해주는 사용자정의함수
 
    With CreateObject("Vbscript.regexp")
    
        .Global = True
        .ignorecase = True
        .Pattern = "[^0-9 오전후:-]"
    
        CreatedDate = Format(.Replace(tmp, ""), "yyyy. m. d")
            
    End With
    
End Function