Solved

vb.net - move pictures

Posted on 2011-03-01
20
579 Views
Last Modified: 2012-05-11
hello there,
I have a little function that tells me when the picture was taken for example "2011:02:27 17:04:45"
I have about 500 pictures in a dir "E:\My Pictures\February" all taken in different days..
what I would like to do is to make a button that will create a new "February" directory and move
the pictures in the new directories by dates.. for example:

"E:\My Pictures\February\2011\02\13"
"E:\My Pictures\February\2011\02\27"
"E:\My Pictures\February\2011\02\25"

etc.. how can I do that?
Imports System.Drawing.Imaging
Imports System.Text

Public Class Form1

    Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
        Debug.Print(FindDateTaken("E:\My Pictures\February\PIC1001.jpg"))
    End Sub

    Function FindDateTaken(ByVal strPicture As String)
        Const DATE_TAKEN As Integer = &H9003
        Dim img As Image = Image.FromFile(strPicture)
        Dim dateTaken As String

        If img.PropertyIdList.Contains(DATE_TAKEN) Then
            Dim pitem As PropertyItem
            pitem = img.GetPropertyItem(DATE_TAKEN)
            dateTaken = Encoding.UTF8.GetString(pitem.Value, 0, pitem.Value.Length)
        Else
            dateTaken = "Not available"
        End If

        Return dateTaken
    End Function
End Class

Open in new window

0
Comment
Question by:XK8ER
  • 9
  • 7
  • 4
20 Comments
 
LVL 85

Expert Comment

by:Mike Tomlinson
ID: 35011780
Try something like this:  *untested
Imports System.IO
Imports System.Text
Imports System.Drawing.Imaging

Public Class Form1

    Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
        Dim Pattern As String = "*.jpg"
        Dim Folder As String = "E:\My Pictures\February"

        Dim di As New DirectoryInfo(Folder)
        For Each fi As FileInfo In di.GetFiles(Pattern)
            Try
                Dim DateTaken As DateTime = FindDateTaken(fi.FullName)
                If Not IsNothing(DateTaken) Then
                    If Not Directory.Exists(Path.Combine(Folder, DateTaken.Year.ToString("00000"))) Then
                        Dim SubDi As DirectoryInfo = di.CreateSubdirectory(DateTaken.Year.ToString("0000"))
                        If Not Directory.Exists(Path.Combine(SubDi.FullName, DateTaken.Month.ToString("00"))) Then
                            SubDi = SubDi.CreateSubdirectory(DateTaken.Month.ToString("00"))
                            If Not Directory.Exists(Path.Combine(SubDi.FullName, DateTaken.Day.ToString("00"))) Then
                                SubDi.CreateSubdirectory(DateTaken.Day.ToString("00"))
                            End If
                        End If
                    End If

                    Dim NewFolder As String = Path.Combine(Folder, DateTaken.ToString("yyyy\MM\dd"))
                    Dim NewFileName As String = Path.Combine(NewFolder, fi.Name)
                    fi.MoveTo(NewFileName)
                End If
            Catch ex As Exception
                MessageBox.Show(ex.ToString, "Error Processing Image", MessageBoxButtons.OK, MessageBoxIcon.Exclamation)
            End Try
        Next
    End Sub

    Private Function FindDateTaken(ByVal strPicture As String) As DateTime
        Const DATE_TAKEN As Integer = &H9003
        Dim img As Image = Image.FromFile(strPicture)
        Dim dateTaken As String

        If img.PropertyIdList.Contains(DATE_TAKEN) Then
            Dim pitem As PropertyItem
            pitem = img.GetPropertyItem(DATE_TAKEN)
            dateTaken = Encoding.UTF8.GetString(pitem.Value, 0, pitem.Value.Length)
            Dim dt As DateTime
            If DateTime.TryParseExact(dateTaken, "yyyy:MM:dd HH:mm:ss", Nothing, Globalization.DateTimeStyles.None, dt) Then
                Return dt
            End If
        End If

        Return Nothing
    End Function

End Class

Open in new window

0
 
LVL 1

Author Comment

by:XK8ER
ID: 35011838
it says the process its being used
0
 
LVL 85

Expert Comment

by:Mike Tomlinson
ID: 35012128
Try this FindDateTaken() function instead:
Private Function FindDateTaken(ByVal strPicture As String) As DateTime
        Const DATE_TAKEN As Integer = &H9003
        Dim img As Image
        Using fs As New FileStream(strPicture, FileMode.Open)
            img = Image.FromStream(fs)
        End Using

        Dim dateTaken As String
        If img.PropertyIdList.Contains(DATE_TAKEN) Then
            Dim pitem As PropertyItem
            pitem = img.GetPropertyItem(DATE_TAKEN)
            dateTaken = Encoding.UTF8.GetString(pitem.Value, 0, pitem.Value.Length)
            Dim dt As DateTime
            If DateTime.TryParseExact(dateTaken, "yyyy:MM:dd HH:mm:ss", Nothing, Globalization.DateTimeStyles.None, dt) Then
                Return dt
            End If
        End If

        Return Nothing
    End Function

Open in new window

0
Live: Real-Time Solutions, Start Here

Receive instant 1:1 support from technology experts, using our real-time conversation and whiteboard interface. Your first 5 minutes are always free.

 
LVL 1

Author Comment

by:XK8ER
ID: 35012682
still file in use.. and says line 28 which is this >>fi.MoveTo(NewFileName)
0
 
LVL 85

Expert Comment

by:Mike Tomlinson
ID: 35012856
Hmmm...well, the act of reading the EXIF data from the file will place a temporary lock on it.  The operating system itself will take an indeterminate amount of time to release the file even though from a .Net perspective we are done with it.

Possible solutions:
(1) Trap the exception and loop until the operation is successful.  *Possibly with a max number of attempts?
(2) Add the files to be moved (along with the new target filename) to a List(Of String) that is processed periodically from a Timer.  As the files are moved you remove them from the List.  If an exception occurs you simply leave it there.  Turn off the Timer when the List is empty.
0
 
LVL 1

Author Comment

by:XK8ER
ID: 35013180
well I commented that line for testing purposes and its not creating the right directory structure..

all I see is "E:\My Pictures\February\0001\01\01" which is wrong..

0
 
LVL 1

Author Comment

by:XK8ER
ID: 35013325
maybe the issue is in FindDateTaken function cus its returning a time and not a date..
0
 
LVL 85

Expert Comment

by:Mike Tomlinson
ID: 35013774
Check what is being extracted in FindDateTaken():

            Dim dt As DateTime
            If DateTime.TryParseExact(dateTaken, "yyyy:MM:dd HH:mm:ss", Nothing, Globalization.DateTimeStyles.None, dt) Then
                Debug.Print(strPicture & " | " & dt.ToString)
                Return dt
            End If
0
 
LVL 5

Expert Comment

by:MedievalWarrior
ID: 35013776
Hi,

You have to close the image stream before moving the file.
0
 
LVL 85

Expert Comment

by:Mike Tomlinson
ID: 35013784
In the second version of FindDateTaken() it should be closed automatically as a "Using" block was implemented:

        Using fs As New FileStream(strPicture, FileMode.Open)
            img = Image.FromStream(fs)
        End Using
0
 
LVL 5

Expert Comment

by:MedievalWarrior
ID: 35013860
Your right Idle_Mind I didn't see that part. I was looking at the authors original code. I think part of the problem could be blank (date taken) properties, images in which no information exists returns null datetime value.
Debug.Print(New DateTime(Nothing))

Open in new window

0
 
LVL 5

Expert Comment

by:MedievalWarrior
ID: 35013899
Here is your test case.
Debug.Print(Test)
Debug.Print(IsNothing(Test))

Private Function Test() As DateTime
 Return Nothing
End Function

Open in new window

0
 
LVL 85

Expert Comment

by:Mike Tomlinson
ID: 35013917
Good spot Medieval.  We could return DateTime.MinValue (or MaxValue) instead of Nothing and check for that instead.
0
 
LVL 85

Expert Comment

by:Mike Tomlinson
ID: 35013925
Note that I had "*untested" on my original post...I don't do that very often.  =\
0
 
LVL 5

Expert Comment

by:MedievalWarrior
ID: 35014148
I have have done much worst things than that Idle_Mind. In fact I have already run into this behavior before and I always use IsNot Nothing because this will let you know if the object in question is a reference type.
If object IsNot Nothing Then

Open in new window

0
 
LVL 1

Author Comment

by:XK8ER
ID: 35015736
>>Debug.Print(strPicture & " | " & dt.ToString)

doesn't output anything
0
 
LVL 85

Expert Comment

by:Mike Tomlinson
ID: 35017140
Move it up one line and see what "dateTaken" is:

            dateTaken = Encoding.UTF8.GetString(pitem.Value, 0, pitem.Value.Length)
            Debug.Print("dateTaken = " & dateTaken & " | strPicture = " & strPicture)
0
 
LVL 1

Author Comment

by:XK8ER
ID: 35018388
it doesn't show anything.. the original code that I posted it does show the date..
0
 
LVL 85

Accepted Solution

by:
Mike Tomlinson earned 500 total points
ID: 35021204
Apologies for the bugs in the code.  For some reason I couldn't get the Parse() method to work even though I had valid values in there.  Also, the Image.FromStream() did not work the same as Image.FromFile()....bizarre!

Here is a *TESTED* version:
Imports System.IO
Imports System.Text
Imports System.Drawing.Imaging
Public Class Form1

    Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
        If FolderBrowserDialog1.ShowDialog = Windows.Forms.DialogResult.OK Then
            ProcessFiles(FolderBrowserDialog1.SelectedPath, "*.jpg")
        End If
    End Sub

    Private Sub ProcessFiles(ByVal Folder As String, ByVal Pattern As String)
        Dim di As New DirectoryInfo(Folder)
        For Each fi As FileInfo In di.GetFiles(Pattern)
            Dim values() As String = FindDateTaken(fi.FullName).Split(":")
            If values.Length >= 2 Then
                values(2) = values(2).Split(" ")(0)
                Try
                    Dim dt As New DateTime(values(0), values(1), values(2))
                    Dim SubDi As New DirectoryInfo(Path.Combine(di.FullName, dt.Year))
                    If Not SubDi.Exists() Then
                        SubDi.Create()
                    End If
                    SubDi = New DirectoryInfo(Path.Combine(SubDi.FullName, dt.Month.ToString("00")))
                    If Not SubDi.Exists() Then
                        SubDi.Create()
                    End If
                    SubDi = New DirectoryInfo(Path.Combine(SubDi.FullName, dt.Day.ToString("00")))
                    If Not SubDi.Exists() Then
                        SubDi.Create()
                    End If

                    Dim NewFileName As String = Path.Combine(SubDi.FullName, fi.Name)
                    fi.MoveTo(NewFileName)
                Catch ex As Exception

                End Try
            End If
        Next
    End Sub

    Private Function FindDateTaken(ByVal strPicture As String) As String
        Const DATE_TAKEN As Integer = &H9003
        Dim dateTaken As String = ""
        Using img As Image = Image.FromFile(strPicture)
            If img.PropertyIdList.Contains(DATE_TAKEN) Then
                Dim pitem As PropertyItem = img.GetPropertyItem(DATE_TAKEN)
                dateTaken = Encoding.UTF8.GetString(pitem.Value, 0, pitem.Value.Length)
            End If
        End Using
        Return dateTaken
    End Function

End Class

Open in new window

0
 
LVL 1

Author Comment

by:XK8ER
ID: 35022609
perfection.. thank you so much!
0

Featured Post

Courses: Start Training Online With Pros, Today

Brush up on the basics or master the advanced techniques required to earn essential industry certifications, with Courses. Enroll in a course and start learning today. Training topics range from Android App Dev to the Xen Virtualization Platform.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Article by: jpaulino
XML Literals are a great way to handle XML files and the community doesn’t use it as much as it should.  An XML Literal is like a String (http://msdn.microsoft.com/en-us/library/system.string.aspx) Literal, only instead of starting and ending with w…
Calculating holidays and working days is a function that is often needed yet it is not one found within the Framework. This article presents one approach to building a working-day calculator for use in .NET.
Windows 10 is mostly good. However the one thing that annoys me is how many clicks you have to do to dial a VPN connection. You have to go to settings from the start menu, (2 clicks), Network and Internet (1 click), Click VPN (another click) then fi…
Although Jacob Bernoulli (1654-1705) has been credited as the creator of "Binomial Distribution Table", Gottfried Leibniz (1646-1716) did his dissertation on the subject in 1666; Leibniz you may recall is the co-inventor of "Calculus" and beat Isaac…

808 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question