Solved

vb.net - move pictures

Posted on 2011-03-01
20
587 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
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 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
Technology Partners: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

 
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

Secure Your Active Directory - April 20, 2017

Active Directory plays a critical role in your company’s IT infrastructure and keeping it secure in today’s hacker-infested world is a must.
Microsoft published 300+ pages of guidance, but who has the time, money, and resources to implement? Register now to find an easier way.

Question has a verified solution.

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

It’s quite interesting for me as I worked with Excel using vb.net for some time. Here are some topics which I know want to share with others whom this might help. First of all if you are working with Excel then you need to Download the Following …
Creating an analog clock UserControl seems fairly straight forward.  It is, after all, essentially just a circle with several lines in it!  Two common approaches for rendering an analog clock typically involve either manually calculating points with…
In a recent question (https://www.experts-exchange.com/questions/29004105/Run-AutoHotkey-script-directly-from-Notepad.html) here at Experts Exchange, a member asked how to run an AutoHotkey script (.AHK) directly from Notepad++ (aka NPP). This video…

740 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