Macro to Read the File Properties for the photos and Put them into Folders by Year and Date

Below Macro helps in opening the Photo or Image Files and read the properties along with Camera the Photo Captured and Dates along with locations and create the Folders by Year, Month and Date if the folders doesn't exist and copy the photos to that folder.

'Creating a FileSystemObject
'Public FSO As New FileSystemObject

Sub ListFiles()
'Declaring variables
Dim objFolder As Folder
Dim objFile As File
Dim strPath As String
Dim NextRow As Long
'Specify the path of the folder
strPath = "E:\My Photos\2005\1152005\"
'Create the object of this folder
Set objFolder = FSO.GetFolder(strPath)
'Check if the folder is empty or not
If objFolder.Files.Count = 0 Then
  MsgBox "No files were found...", vbExclamation
  Exit Sub
End If
'Adding Column names for A, B, and C
Cells(1, "A").Value = "File Name"
Cells(1, "B").Value = "Size"
Cells(1, "C").Value = "Modified Date/Time"
Cells(1, "D").Value = "Date Taken"
'Find the next available row
NextRow = ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row + 1
'Loop through each file in the folder
For Each objFile In objFolder.Files
'List the name, size, and date/time of the current file
Cells(NextRow, 1).Value = objFile.Name
Cells(NextRow, 2).Value = objFile.Size
Cells(NextRow, 3).Value = objFile.DateLastAccessed
Cells(NextRow, 4).Value = objFile.Att(objFile, 12)
'Find the next row
NextRow = NextRow + 1
Next objFile
End Sub

'The date a picture was taken happens to be property #25, so you can use

Private Sub Show_Image_Date()

Dim fPath As Variant
Dim objShell As Object
Dim objFolder As Object
Dim strFileName As Object
Dim createDate As String
Dim HashValue As String

Worksheets("Sheet1").Activate

fPath = ActiveSheet.Cells(1, 2).Value
'fPath = "E:\Test"

Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.Namespace(fPath)

Worksheets("Sheet2").Activate

'Adding Column names for A, B, and C
Cells(1, "A").Value = "File Name"
Cells(1, "B").Value = "Date Taken"
Cells(1, "C").Value = "Folder Name"
Cells(1, "D").Value = "Year"
Cells(1, "E").Value = "Camera Make"
Cells(1, "F").Value = "Camera Model"
Cells(1, "G").Value = "Title"
Cells(1, "H").Value = "CopyRight"
Cells(1, "I").Value = "Author"
Cells(1, "J").Value = "File Copy Status"

NextRow = ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row + 1

'Loop through all Items (files) in folder "C:\Files"
For Each strFileName In objFolder.Items
'strFileName = "file#26.jpg"

'Look only for image files
'If InStr(objFolder.GetDetailsOf(strFileName, 9), "Image") Then

'Ignore if EXIF missing
'If Len(objFolder.GetDetailsOf(strFileName, 27)) > 0 Then
'12 - Date Taken, 30-Camera Model,32-Camera Make, 18 - Tags, 19 - Ratings, 20 - Authors, 21 - Title, 25 - Copy Right
'MsgBox "Date Taken = " & objFolder.GetDetailsOf(strFileName, 12), , strFileName
'MsgBox "Date Taken = " & objFolder.GetDetailsOf(strFileName, 47), , strFileName

'List the name, size, and date/time of the current file
Cells(NextRow, 1).Value = strFileName
If Len(objFolder.GetDetailsOf(strFileName, 12)) > 0 Then
Cells(NextRow, 2).Value = objFolder.GetDetailsOf(strFileName, 12)
createDate = Trim(objFolder.GetDetailsOf(strFileName, 12))
HashValue = Left$(createDate, 1)
createDate = Replace(createDate, HashValue, "")
createDate = Replace(createDate, "/", "")
'createDate = Replace(Trim(objFolder.GetDetailsOf(strFileName, 12)), "/", "")
createDate = Trim(Left(createDate, Len(createDate) - 9))
Cells(NextRow, 3).Value = createDate
createDate1 = Right$(createDate, 4)
Cells(NextRow, 4).Value = createDate1
End If
Cells(NextRow, 5).Value = objFolder.GetDetailsOf(strFileName, 32)
Cells(NextRow, 6).Value = objFolder.GetDetailsOf(strFileName, 30)
Cells(NextRow, 7).Value = objFolder.GetDetailsOf(strFileName, 21)
Cells(NextRow, 8).Value = objFolder.GetDetailsOf(strFileName, 25)
Cells(NextRow, 9).Value = objFolder.GetDetailsOf(strFileName, 20)
Cells(NextRow, 10).Value = "Not Copied"

If Cells(NextRow, 2).Value = "" Then
Cells(NextRow, 2).Value = "Bad File"
Cells(NextRow, 3).Value = "01011901"
Cells(NextRow, 4).Value = "1901"
End If

'Find the next row
NextRow = NextRow + 1
'Cells(1, 1).Value = strFileName
'Cells(1, 2).Value = objFolder.GetDetailsOf(strFileName, 12)

'End If

'End If

Next

End Sub
Sub ChkFolder()
Dim DateFolder_name As String
Dim YearFolder_name As String
Dim DatePath As String
Dim YearPath As String
Dim SourcePath As String
Dim SourcePath1 As String
Dim TargetPath As String
Dim Copyright As String

Worksheets("Sheet1").Activate

TargetPath = ActiveSheet.Cells(3, 2).Value '"C:\temp\"
SourcePath = ActiveSheet.Cells(2, 2).Value

Worksheets("Sheet2").Activate

RowCount = ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row
'NextRow = ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row + 1
For r = 2 To RowCount
Copyright = Cells(r, 8).Value
If Copyright = "" Then
    'If Cells(r, 2).Value <> "Bad File" Then
    If Cells(r, 10).Value <> "Copied" Then
        YearPath = Trim(Cells(r, 4).Value)
        DatePath = Trim(Cells(r, 3).Value)
        YearFolder_name = TargetPath & YearPath
        DateFolder_name = YearFolder_name & "\" & DatePath & "\"
'MsgBox "Date Taken = " & Cells(r, 3).Value
        If Dir(YearFolder_name, vbDirectory) = "" Then
            MkDir YearFolder_name
        End If
        If Dir(DateFolder_name, vbDirectory) = "" Then
            MkDir DateFolder_name
        '    Else
'        MsgBox "Directory exists."
        End If
        SourcePath1 = SourcePath & Cells(r, 1).Value
        FileCopy SourcePath1, DateFolder_name & Cells(r, 1).Value
        Cells(r, 10).Value = "Copied"
    End If
End If
Next r

End Sub

Private Sub Junk()
Dim fPath As Variant
Dim FileObj As Object
Dim objFolder As Object
Dim strFileName As Object

'fPath = "E:\My Photos\2005\1152005"

'Set FileObj = CreateObject("Shell.Application")
'Set objFolder = FileObj.Namespace(fPath)

'For Each strFileName In objFolder.Items

'MsgBox "Date Taken = " & objFolder.GetDetailsOf(strFileName, 30)
'18 - Tags, 19 - Ratings, 20 - Authors, 21 - Title, 25 - Copy Right

MsgBox "Date Taken = " & Cells(2, 8).Value
'MsgBox "Date Taken = " & Cells(35, 3).Value
'Next
End Sub
Sub All()
Show_Image_Date
ChkFolder
End Sub