IsTime Function

[Dreamweaver]

That's correct.
DateTaken is a property of the JPG file itself which is designed to be unchanged if the file is edited, renamed etc.
Though of course it is lost if you convert the file to png etc.
I don't follow your comment about developing the code for this.
The code to extract that from extended file properties already exists.
As already mentioned, you can't get it using file system object.

I just ment solving my current problem with the format and completing my import engine code with the updates.


I thought it might have been a problem with files stored on one drive so copied some into a local folder and still getting the problem with the ?? code below

Private Sub fnFolderItem2ExtendedPropertyVB()
Dim StrD As Variant

With CreateObject("Shell.Application").Namespace("C:\Kylie Minogue\Pictures")
        StrD = .GetDetailsOf(.Items.Item("G2-P14.jpg"), 12)
    End With
        StrD = Replace(StrD, "?", "", 1)
    Debug.Print StrD
End Sub

 

[isladogs]

As already mentioned, the '?' marks weren't removed for me either when I tried that code.
Why don't you adapt my code so it just pulls property 12 instead of looping through all 311 properties. The '?' marks are successfully removed with my code

 

[Dreamweaver]

Just running your FileAttributesV4.accdb And got a page width error for the list attributes by type and also the one below when running the get attributes

 

[Dreamweaver]

As already mentioned, the '?' marks weren't removed for me either when I tried that code.
Why don't you adapt my code so it just pulls property 12 instead of looping through all 311 properties. The '?' marks are successfully removed with my code

I will look at doing that but thought they both worked the same way but will give it a go thanks

 

[isladogs]

Just running your FileAttributesV4.accdb And got a page width error for the list attributes by type and also the one below when running the get attributes

I've never seen that issue but you are using an old version of the app.
I've just posted a newer version of the app to sample databases.
I've just re-tested using the new version on a folder of almost 1000 images with no errors. It will take a few minutes for a large number of images but the results can be saved for future use

See if the new version has the same issue for you.
If so, try debugging to find out exactly which field triggers the error.
The text field sizes are the maximum 255 for text fields FilePath, FileName & ExtPropValue.
I have a vague memory of you using very long file paths. If you have e.g. very long file paths of more than 255 characters, you could try changing to a memo/long text field...but that may limit some functionality ...or use shorter file paths

 

[Dreamweaver]

I've never seen that issue but you are using an old version of the app.
I've just posted a newer version of the app to sample databases.
I've just re-tested using the new version on a folder of almost 1000 images with no errors. It will take a few minutes for a large number of images but the results can be saved for future use

See if the new version has the same issue for you.
If so, try debugging to find out exactly which field triggers the error.
The text field sizes are the maximum 255 for text fields FilePath, FileName & ExtPropValue.
I have a vague memory of you using very long file paths. If you have e.g. very long file paths of more than 255 characters, you could try changing to a memo/long text field...but that may limit some functionality ...or use shorter file paths

I'll download the update but I used a local folder no more than 2 deep


Just updated your code as below will post the debug results under code I still need to clean it up for my program but It does work but look at the results

Public Function GetFileAttributes(strFilePath As String)

strProc = "GetFileAttributes"
   
 On Error GoTo Err_Handler
 
 'get file details
    I = 1
    strFileName = strFilePath
    Do Until I = 0 'find the last "\" and get the filename
        I = InStr(1, strFileName, "\", vbBinaryCompare)
        strFileName = Mid(strFileName, I + 1)
    Loop
    
    strPath = Left(strFilePath, Len(strFilePath) - Len(strFileName) - 1)
    
    Set objShell = New Shell
    Set objFolder = objShell.NameSpace(strPath)
    Set objFolderItem = objFolder.ParseName(strFileName)
        
 'get attributes & values and save to table tblFileAttributesTEMP
        aName = objFolder.GetDetailsOf(objFolder.Items, 12)
        aValue = objFolder.GetDetailsOf(objFolderItem, 12)
       
       'full list of available attributes (depending on file type)
       Debug.Print objFolder.GetDetailsOf(objFolder.Items, 12)
        
        'list attributes available in this folder:
        If Nz(aName, "") <> "" And Nz(aValue, "") <> "" Then
            Debug.Print aName & ": " & aValue
            
            'append query fails if any aName contains a '; replace with a |
            If InStr(aName, "'") > 0 Then
                aName = Replace(aName, "'", "|")
                N = N + 1
            End If
            
            'remove any '?' in attribute value
            aValue = Replace(aValue, "?", "")
        Debug.Print aValue
            'append record to tblAttributesFileType
        End If
    
    
    Set objFolderItem = Nothing
    Set objFolder = Nothing
    Set objShell = Nothing
   
Exit_Handler:
    Exit Function
    
Err_Handler:
    MsgBox "Error " & Err.Number & " in " & strProc & " procedure: " & Err.Description
    Resume Exit_Handler

End Function

Results

?GetFileAttributes("C:\Kylie Minogue\Singles Covers\20140108_235915.jpg")
Date taken
Date taken: ?08/?01/?2014 ??23:59
?08/?01/?2014 ??23:59

I will check your updated version code thanks

 

[Dreamweaver]

I am getting the error attached which relates to the CurrentDb.Execute strSQL


I also noticed The 2 files I tested both tested with my code and your code I'm playing with which gate a date taken no longer seem to list that property on the report.


mick

 

[isladogs]

I am getting the error attached which relates to the CurrentDb.Execute strSQL

I also noticed The 2 files I tested both tested with my code and your code I'm playing with which gate a date taken no longer seem to list that property on the report.

mick

I'm unclear whether you are using the latest version of my app, an older version or have imported code into your own app. If the latter you may need to add additional references as in my apps.

There are several sql statements executed!
The code first replaces any apostrophes in the filename with the pipe symbol '¦' (to avoid errors) then restores the apostrophe afterwards

EDIT: Just checked - that line is not working for some reason at the moment - I'll investigate later today

Don't understand the second sentence.

As for your '?' marks not being deleted, perhaps its a different character that looks similar???

I'm logging off for a few hours so I'll leave you to investigate the code with your own files.

 

[Dreamweaver]

Just noticed that lol

        strSQL = "UPDATE tblExtPropsFileType SET tblExtPropsFileType.ExtProperty = Replace([ExtProperty],'|',''');"
        CurrentDb.Execute strSQL

The 2 images were tested on your new version which didn't give the date taken property in the report???

 

[Dreamweaver]

I can't spend more time on this as it seems to work on your system but not mine I'm going to use my original code as it's simpler and format the date taken with a sting format like I used for the filename that way I can be sure of the result and test for problems.


thanks mick

 

[isladogs]

Thanks.
In fact there are a couple of related errors in that section of code.
Not sure how its missed being picked up before.
I'll let you know when I've updated it later today

 

[isladogs]

OK - fixed it! Amended code for that procedure in RED
Updated version will be uploaded to sample databases later when I've checked for other bugs

Public Sub GetFileExtProps(strFilePath As String)

strProc = "GetFileExtProps"

'This requires the reference: Microsoft Shell Controls and Automation

'Examples:
   'GetFileExtProps "G:\Programs\MendipDataSystems\CommonFiles\SDA\Icons\SDA_DEMO.ico"
   'GetFileExtProps "G:\Programs\MendipDataSystems\CommonFiles\SDA\Images\AccessErrorCodes.gif"
   'GetFileExtProps "G:\Programs\MendipDataSystems\CommonFiles\SDA\Photos\000146.bmp"
   'GetFileExtProps "G:\Programs\MendipDataSystems\CommonFiles\SDA\Documentation\AnalyseSessionReportGrades.pdf"
   'GetFileExtProps "D:\Colin\My Documents\My Music\Leonard Cohen\You Want It Darker\04 Leaving The Table.mp3"
   'GetFileExtProps "C:\Programs\MendipDataSystems\SDALink\Spreadsheets\SIMs_StudentAttendanceMarks_Yr09.csv"
   'GetFileExtProps "C:\Programs\MendipDataSystems\SPS\SPS.accdb"
   'GetFileExtProps "C:\Programs\MendipDataSystems\SDA\ExportImportTemplates\Template.xlsx"
   
 On Error GoTo Err_Handler
 
   'clear temp table - left out of v4 by mistake
   CurrentDb.Execute "DELETE tblFileExtPropsTEMP.* FROM tblFileExtPropsTEMP;"
 
 'get file details
    I = 1
    strFileName = strFilePath
    Do Until I = 0 'find the last "\" and get the filename
        I = InStr(1, strFileName, "\", vbBinaryCompare)
        strFileName = Mid(strFileName, I + 1)
    Loop
    
    strPath = Left(strFilePath, Len(strFilePath) - Len(strFileName) - 1)
    
    Set objShell = New Shell
    Set objFolder = objShell.NameSpace(strPath)
    Set objFolderItem = objFolder.ParseName(strFileName)
    
    N = 0
    
 'get extended properties & values and save to table tblFileExtPropsTEMP
    For I = 0 To 310
        aName = objFolder.GetDetailsOf(objFolder.Items, I)
        aValue = objFolder.GetDetailsOf(objFolderItem, I)
       
       'full list of available extended properties (depending on file type)
       'Debug.Print I & " - " & objFolder.GetDetailsOf(objFolder.Items, I)
        
        'list extended properties available in this folder:
        If Nz(aName, "") <> "" And Nz(aValue, "") <> "" Then
        '    Debug.Print I & " - " & aName & ": " & aValue
            
            'append query fails if any [COLOR="DarkRed"]aValue[/COLOR] contains a '; replace with a |
           [COLOR="darkred"] If InStr(aValue, "'") > 0 Then
                aValue = Replace(aValue, "'", "|")[/COLOR]
                N = N + 1
            End If
            
        '    Debug.Print aName, aValue, N
            
            'remove any '?' in extended property value
            aValue = Replace(aValue, "?", "")
        
            'append record to tblExtPropsFileType
            strSQL = "INSERT INTO tblFileExtPropsTEMP ( ID, ExtProperty, ExtPropValue )" & _
                " SELECT " & I & " AS ID, '" & aName & "' AS ExtProperty, '" & aValue & "' AS ExtPropValue ;"
                                
            CurrentDb.Execute strSQL
        End If
    Next I
    
    'now restore any ' replaced earlier with a |
    If N > 0 Then
        strSQL = "UPDATE tblFileExtPropsTEMP SET tblFileExtPropsTEMP.ExtPropValue = Replace([ExtPropValue][COLOR="darkred"],'|','''');"[/COLOR][COLOR="SeaGreen"] 'note this is 4 apostrophes NOT two double quotes[/COLOR]
        CurrentDb.Execute strSQL
    End If
    
    Set objFolderItem = Nothing
    Set objFolder = Nothing
    Set objShell = Nothing
   
Exit_Handler:
    Exit Sub
    
Err_Handler:
    MsgBox "Error " & Err.Number & " in " & strProc & " procedure: " & Err.Description
    Resume Exit_Handler

End Sub

 

[Dreamweaver]

Don't know if you want to try it but just wrote this for the namespace and file name


Dim StrNameSpace As Variant, StrFileName As Variant

StrNameSpace = Left(StrFile, InStrRev(StrFile, "\") - 1)
StrFileName = Right(StrFile, Len(StrFile) - InStrRev(StrFile, "\"))

mick


Did you know you can use something like
Public Const QUOTE = """" 'Used in SQL strings where the ' char may be used in text strings
Above credit Peter Hibbs

 

[Dreamweaver]

This is what I'm using as for sum reason the replace didn't work this does rely on the format but I can test that
But It works just fine needs more testing though

Public Function GetTimeTaken(StrFile) As String
Dim StrD As String, StrNameSpace As Variant, StrFileName As Variant
Dim Y As Double, M As Double, D As Double
Dim DTime As String
Dim Dt As Date
On Error GoTo HandleErr
StrNameSpace = Left(StrFile, InStrRev(StrFile, "\") - 1)
StrFileName = Right(StrFile, Len(StrFile) - InStrRev(StrFile, "\"))
'Debug.Print StrNameSpace
'Debug.Print StrFileName

With CreateObject("Shell.Application").NameSpace(StrNameSpace)
        StrD = .GetDetailsOf(.Items.Item(StrFileName), 12)
    End With
        If StrD <> "" Then
            D = Mid(StrD, 2, 2)
            M = Mid(StrD, 6, 2)
            Y = Mid(StrD, 10, 4)
            DTime = Right(StrD, Len(StrD) - InStrRev(StrD, " ") - 2)
        End If
        Dt = CDate(DateSerial(Y, M, D) & " " & DTime & ":00")
    Debug.Print Dt
    

HandleExit:
    Exit Function
    
HandleErr:
    Select Case Err.Number
        Case Else
            MsgBox Err.Number & vbCrLf & Err.Description
            Resume HandleExit
        Resume
    End Select
End Function

 

[Dreamweaver]

I would like to thank all for their help Esp Isladogs I have now completed works on the import engine


It now uses a 3 tier check using functions posted
First it checks for A Date Taken if that returns "" it will check the filename for dates if no luck there it runs to mummy and gets the file created details



on running I found to do the first 100 images it took 48.13 seconds but that was with it having to get the file count so afer that I was looking at just over 30 seconds per 100


thanks


mick

 

[isladogs]

I've just uploaded a further update to my extended file properties app to sample databases. Copy attached here also
Version 2.1 includes various bug fixes mainly related to files with apostrophes in the filename/path plus some other tidying up.
Hopefully now bug free again.

@MickJav
Thanks for alerting me to issues I thought I'd solved long ago!

I've repeatedly tested mycode with JPG files and it successfully removed all '?' in values for fields such as DateTaken. Unable to replicate your issue

 

[Dreamweaver]

I've just uploaded a further update to my extended file properties app to sample databases. Copy attached here also
Version 2.1 includes various bug fixes mainly related to files with apostrophes in the filename/path plus some other tidying up.
Hopefully now bug free again.

@MickJav
Thanks for alerting me to issues I thought I'd solved long ago!

I've repeatedly tested mycode with JPG files and it successfully removed all '?' in values for fields such as DateTaken. Unable to replicate your issue

No Problem I'll download the update and run it againt some of my image files and let you know


I have notices one quirk related to the dimensions relating to portrat images a lot of mine are turned sideways but the dimensions show them as landscape It's not your code for some reason unless you edit the file they all seem to end up as landscape, I found this when looking at using the returned dimensions to run a simple bit of math to find out if the image was portat or landscape I have a fix for my program as I have created thumbnails I'll use them for the protrat/Landscape but it will add time as I will need to open both main and thumbnail If it adds to much I'll live without it lol


Of out now back later


mick