[AccessD] Access files by date

Tue Aug 1 09:56:22 CDT 2017

No!  It's Ugly!

Well...ok...If you post your email address, I'll send you the accdb offline
as well so if you want to fool with it you won't have to parse out all the
line feeds and other trash that accumulates in the email:

R

Option Compare Database
Option Explicit

Dim strFolder As String
Dim strFileSpec As String
Dim strFileName As String
Dim strNewName As String

Dim fs As Object
Dim f As Variant
Dim s As Variant
Dim s2 As Variant

Dim datDate As Date

Dim intI As Integer

Dim rs As DAO.Recordset

Dim lngCount As Long
Dim lngFileNumber As Long

Private Sub Command0_Click()

strFolder = "C:\Users\Rocky\Desktop\Redwood Ride Pictures\Mashup\"
strFileSpec = "*.*"

MsgBox GetPhotos & " And Done."

End Sub

Function GetPhotos() As Long

  Set fs = CreateObject("Scripting.FileSystemObject")

  CurrentDb.Execute "Delete * FROM tblPhotos"

' Get the files into the table withth eir original taken date
  Set rs = CurrentDb.OpenRecordset("Select * FROM tblPhotos")
  MsgBox strFolder & strFileSpec

  strFileName = Dir$(strFolder & strFileSpec)
  While strFileName <> ""
       Set f = fs.GetFile(strFolder & strFileName)
       s = GetProperty(strFolder & strFileName, 12)
       rs.AddNew
       rs!fldPhotosFileName = strFileName
       s2 = ""
       ' make some characters blank
       For intI = 1 To Len(s)
        If Mid(s, intI, 1) = "/" Or Mid(s, intI, 1) = ":" Or Mid(s, intI, 1)
= " " Then
            s2 = s2 + Mid(s, intI, 1)
            GoTo NextIntI:
        End If

        ' make the non aplhanumeric characters zero
        If (Asc(Mid(s, intI, 1)) >= 65 And Asc(Mid(s, intI, 1)) <= 90) Or
(Asc(Mid(s, intI, 1)) >= 48 And Asc(Mid(s, intI, 1)) <= 57) Then
            s2 = s2 + Mid(s, intI, 1)
        Else
            s2 = s2 + "0"
        End If
NextIntI:
    Next intI

       If s2 = "" Then s2 = FileDateTime(strFolder & strFileName)
       rs!fldPhotosFileDate = s2
       rs.Update
       lngCount = lngCount + 1
       strFileName = Dir$
  Wend
  rs.Close
  Set rs = Nothing
  GetPhotos = lngCount

' Rename files in chrono sequence
    lngFileNumber = 0

  Set rs = CurrentDb.OpenRecordset("Select * FROM tblPhotos ORDER BY
fldPhotosFileDate")
  Do While rs.EOF = False

    lngFileNumber = lngFileNumber + 10
    strNewName = strFolder & "RR" & Right("0000" & Trim(Str(lngFileNumber)),
4) & ".jpg"

    ' rename file in folder and save the new name in the table for later
inspection
    ' (to see if it really worked)
    Name strFolder & rs!fldPhotosFileName As strNewName
    rs.Edit
    rs!fldPhotosFileNewName = strNewName
    rs.Update

    rs.MoveNext
    If rs.BOF = False And rs.EOF = False Then datDate = rs!fldPhotosFileDate
Loop

  End Function

Function GetProperty(strFile, n)
Dim objShell
Dim objFolder
Dim objFolderItem
Dim i
Dim strPath
Dim strName
Dim intPos

'On Error GoTo ErrHandler

intPos = InStrRev(strFile, "\")
strPath = Left(strFile, intPos)
strName = Mid(strFile, intPos + 1)
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.Namespace(strPath)
Set objFolderItem = objFolder.ParseName(strName)
If Not objFolderItem Is Nothing Then
' search jpg header fields to find which one is the original date taken
field
'MsgBox objFolder.GetDetailsOf(objFolderItem, 10)
'MsgBox objFolder.GetDetailsOf(objFolderItem, 11)
'MsgBox objFolder.GetDetailsOf(objFolderItem, 12)
'MsgBox objFolder.GetDetailsOf(objFolderItem, 13)
'MsgBox objFolder.GetDetailsOf(objFolderItem, 14)
'MsgBox objFolder.GetDetailsOf(objFolderItem, 15)
'MsgBox objFolder.GetDetailsOf(objFolderItem, 16)
' turns out to be field 12
GetProperty = objFolder.GetDetailsOf(objFolderItem, 12)
End If

ExitHandler:
Set objFolderItem = Nothing
Set objFolder = Nothing
Set objShell = Nothing
Exit Function

ErrHandler:
MsgBox Err.Description, vbExclamation
Resume ExitHandler
End Function

-----Original Message-----
From: AccessD [mailto:accessd-bounces at databaseadvisors.com] On Behalf Of Dan
Waters
Sent: Tuesday, August 01, 2017 7:47 AM
To: Access Developers discussion and problem solving
Subject: Re: [AccessD] Access files by date

Hi Rocky,

Could you post that code here?  I'd like to see how this was done too.

Thanks!
Dan

-----Original Message-----
From: AccessD [mailto:accessd-bounces at databaseadvisors.com] On Behalf Of
Rocky Smolin
Sent: July 31, 2017 22:45
To: 'Access Developers discussion and problem solving'
Subject: Re: [AccessD] Access files by date

Bob:

Are you still interested in the sort-photos-by-date-and-rename program?  I
can send it to you with or without the phone consult.  Not the version that
I first posted but the one that really works off the photo taken date in the
jpg header.

Best,

R

-----Original Message-----
From: AccessD [mailto:accessd-bounces at databaseadvisors.com] On Behalf Of Bob
Heygood
Sent: Thursday, July 27, 2017 7:42 AM
To: 'Access Developers discussion and problem solving'
Subject: Re: [AccessD] Access files by date

Great solution.
I have a need that this will work for as well.

Thx
Bob Heygood

-----Original Message-----
From: AccessD [mailto:accessd-bounces at databaseadvisors.com] On Behalf Of
Stuart McLachlan
Sent: Monday, July 24, 2017 1:10 AM
To: Access Developers discussion and problem solving
Cc: 'Off Topic'
Subject: Re: [AccessD] Access files by date

I'd create a table to store all the filenames and dates with whatever other
fields you need for new filenames, comments or whatever.  Then a simple
function:

Function GetPhotos() As Long
Dim strFName As String
Dim fdate As Date
Dim rs As DAO.Recordset
Dim lngCount As Long
Set rs = CurrentDb.OpenRecordset("tblPhotos")
strFilename = Dir$(CurrentProject.payh & "\*.jpg") While strFilename > ""
     rs.AddNew
     rs!FileName = strFilename
     rs!Filedate = fdate = FileDateTime(CurrentProject.Path & "\" &
strFilename)
     rs.Update
     lngCount = lngCount + 1
    strFilename = Dir$
Wend
rs.Close
Set re = Nothing
GetPhotos = lngCount
End Function

Once you have then in the table you can do anything you want with the data,
manually or with VBA.

On 23 Jul 2017 at 21:36, Rocky Smolin wrote:

> Dear List:
> 
> 
> 
> Having just returned from a 5 day 250 mile bike trek through the 
> redwoods of northern California with a group of 0 guys, I have 
> volunteered to assemble everyone's pictures and edit them down to a 
> director's cut.
> 
> 
> 
> What I have done after editing all their photos (and discarding many) 
> is put everyone's pictures in one folder which I can then display by 
> date.  Since everyone (hopefully) has a correct date time stamp, the 
> pictures of like places and times are now grouped together.
> 
> 
> 
> So now I would like to loop through these picture in date sequence, 
> and rename them RR00010, RR00020, RR0030, etc.  so I can then do a bit 
> of rearranging by changing file names. Once that's done I can do a 
> final cull of the pictures and, if I need to manually insert any in a 
> different place I can do it - like RR00025 would go between RR00020 
> and RR00030.
> 
> 
> 
> I'm having a little though, trouble extracting this solution from the 
> web. Can someone point me in the right direction?  Can this all be 
> done with FSO? My first attempt retrieved the pics in file name order, 
> not date/time order. And don't see a way using the Dir command to do 
> that.
> 
> 
> 
> MTIA
> 
> 
> 
> 
> 
> Rocky Smolin
> 
> Beach Access Software
> 
> 760-683-5777
> 
>  <http://www.bchacc.com> www.bchacc.com
> 
>  <http://www.e-z-mrp.com> www.e-z-mrp.com
> 
> Skype: rocky.smolin
> 
> 
> 
> 
> 
> --
> AccessD mailing list
> AccessD at databaseadvisors.com
> http://databaseadvisors.com/mailman/listinfo/accessd
> Website: http://www.databaseadvisors.com
> 

--
AccessD mailing list
AccessD at databaseadvisors.com
http://databaseadvisors.com/mailman/listinfo/accessd
Website: http://www.databaseadvisors.com

--
AccessD mailing list
AccessD at databaseadvisors.com
http://databaseadvisors.com/mailman/listinfo/accessd
Website: http://www.databaseadvisors.com

--
AccessD mailing list
AccessD at databaseadvisors.com
http://databaseadvisors.com/mailman/listinfo/accessd
Website: http://www.databaseadvisors.com

--
AccessD mailing list
AccessD at databaseadvisors.com
http://databaseadvisors.com/mailman/listinfo/accessd
Website: http://www.databaseadvisors.com