Solved

vb.net - move pictures

Posted on 2011-03-01
20
570 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
 
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
Maximize Your Threat Intelligence Reporting

Reporting is one of the most important and least talked about aspects of a world-class threat intelligence program. Here’s how to do it right.

 
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

Maximize Your Threat Intelligence Reporting

Reporting is one of the most important and least talked about aspects of a world-class threat intelligence program. Here’s how to do it right.

Join & Write a Comment

I think the Typed DataTable and Typed DataSet are very good options when working with data, but I don't like auto-generated code. First, I create an Abstract Class for my DataTables Common Code.  This class Inherits from DataTable. Also, it can …
If you're writing a .NET application to connect to an Access .mdb database and use pre-existing queries that require parameters, you've come to the right place! Let's say the pre-existing query(qryCust) in Access takes a Date as a parameter and l…
This video shows how to remove a single email address from the Outlook 2010 Auto Suggestion memory. NOTE: For Outlook 2016 and 2013 perform the exact same steps. Open a new email: Click the New email button in Outlook. Start typing the address: …
You have products, that come in variants and want to set different prices for them? Watch this micro tutorial that describes how to configure prices for Magento super attributes. Assigning simple products to configurable: We assigned simple products…

758 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

Need Help in Real-Time?

Connect with top rated Experts

21 Experts available now in Live!

Get 1:1 Help Now