VBA - Using Timer function to select files created within interval

[ZachAtaiyan]

Hello all,



I would like to preface this post with the fact that I am fairly new to coding, especially VBA.

I have created an object on my form that when clicked, calls a third party camera utility application. I would like to create another object that when clicked will attach to a record all of the images taken in the folder since the camera app was called. It makes sense to me that this can be done using the Timer command to determine the files that were created since the timer began. I know this would be easier to do if I could dictate how the files were named, however, I do not have that luxury with the utility I am using.

I really appreciate any suggestions or other help I can get. Thanks!

ZA

[burrina]

Storing images in your database will cause bloat and is not recommended. Better to simply store in a folder and then re query your data.

[ZachAtaiyan]

Storing images in your database will cause bloat and is not recommended. Better to simply store in a folder and then re query your data.

I understand this. However, for our purposes we would like to keep everything in the same file. The file sizes of the jpegs would be 300kb each, which would take roughly 3500 images to hit the 2gb file size cap. At what file size does bloat start to occur?

thanks in advance

[ItsMe]

Rather than using the form's timer event I would probably store a timestamp in a variable for the very first click event of the snapshot and then a timestamp for the "Save" click event.

[ZachAtaiyan]

Rather than using the form's timer event I would probably store a timestamp in a variable for the very first click event of the snapshot and then a timestamp for the "Save" click event.

That seems like a more straightforward process. Is there a way to select files that were created during a specified time interval?

[ItsMe]

You would have to go after file attributes using Shell.Application. In order to get what you need done, will require good understanding of VBA.

[ZachAtaiyan]

I am kind of at a stand still at this point...I used the Now command to capture a timestamp to compare to each files creation date. Can anyone tell me why I would get the following errors from this code?

• Indew or Primary Key cannot contain a null value
• Resume without error
• (endless blank error messages)

Also, Nothing is importing (Duh). I would appreceate any help on this. Thanks in advance!

Private Sub Command33_Click()
On Error GoTo Err_AddImage
Dim FileName As String
Dim Directory As String
Dim oFile As Object
Dim ImportFile As String
'Import Attachments
Dim db As DAO.Database
Dim rsParent As DAO.Recordset2
Dim rsChild As DAO.Recordset2
Set db = CurrentDb
Set rsParent = Me.Recordset
rsParent.Edit
Set rsChild = rsParent.Fields("Field1").Value
rsChild.AddNew
    'File Source Folder
    Directory = "C:\Users\zfataiyan\Desktop\TESTFOLDER\"
    If Right(Directory, 1) <> "\" Then
        Directory = Directory & "\"
    End If
    
    'Search for all files in the directory with an .jpg* file type.
    FileName = Dir(Directory, vbNormal)
    Set oFile = CreateObject("Scripting.FileSystemObject")
''''''''''''''''''''''''''''
    'Opens, searches through and closes each file
    Do While FileName <> ""
    OpenFile = Directory & FileName
        If oFile.GetFile(Directory & FileName).DateCreated >= Time1 And oFile.GetFile(Directory & FileName).DateCreated <= Time2 Then
        
        'TARGET DESTINATION
        rsChild.Fields("FileData").LoadFromFile FileName
        End If
        
        rsChild.Update
        rsParent.Update
        
     FileName = Dir()
    OpenFile = ""
    Loop
    
        rsChild.Update
        rsParent.Update
    
Exit_AddImage:
        Set rsChild = Nothing
        Set rsParent = Nothing
Exit Sub
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Err_AddImage:
If Err = 3820 Then
MsgBox ("File already part of the multi-valued field!")
Resume Next
Else
MsgBox Err.Description
Resume Err_AddImage
End If
End Sub 

[ItsMe]

I would probably start by developing some code that enumerated file names that matched your timestamp criteria.

Maybe like
Debug.Print XXXX.Name

Then use Keyboard Shortcut Ctrl+G to view result in Immediate Window

Test that block of code first. I will take a look at this a little later. Here is some code that retrieves attributes if you get stuck. You will probably only be able to see a couple of files attributes at a time in the Immediate Window because of character limits.

Dim arrAttribute(35) As String
Dim objShell As Object
Dim objFolder As Object
Dim i As Integer
Dim varItemName As Variant
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.NameSpace("C:\Test\Attrib")
    
    For Each varItemName In objFolder.Items
        Debug.Print "varItemName = " & varItemName & vbCrLf & "..."
            For i = 0 To 34
                arrAttribute(i) = objFolder.GetDetailsOf(objFolder.Items, i)
                Debug.Print arrAttribute(i) & ": " & objFolder.GetDetailsOf(varItemName, i)
            Next
        Debug.Print "=================== End " & varItemName & " ===================" & vbCrLf & vbCrLf
    Next

[ZachAtaiyan]

Thank you, I realize what I posted is really messy... I actually just scrapped the whole thing and rewrote it. here:

Now when I execute the command, nothing happens. Any ideas? The last error I was getting was because I was referencing an object that I hadn't created yet. Thanks!

Private Sub Command33_Click()
On Error GoTo Err_AddImage
Dim db As DAO.Database
Dim rsParent As DAO.Recordset2
Dim rsChild As DAO.Recordset2
Dim FileName As String
Dim Directory As String
Dim FSO As Object
Dim Time1 As Date
Dim Time2 As Date
Set db = CurrentDb
Set rsParent = Me.Recordset
rsParent.Edit
Set rsChild = rsParent.Fields("Field1").Value
    'File Source Folder
    Directory = "C:\Users\zfataiyan\Desktop\TESTFOLDER"
        If Right(Directory, 1) <> "\" Then
            Directory = Directory & "\"
        End If
    
    'Search for all files in the directory with an .jpg* file type.
         FileName = Dir(Directory, vbNormal)
'Use Do loop to add files created after Time1 and Before Time2.
    Set FSO = CreateObject("Scripting.FileSystemObject")
'''''Loop Time''''''--------------------------------------------
''''''''''''''''''''
Do While FileName <> ""
    OpenFile = Directory & FileName
    If FSO.GetFile(Directory & FileName).DateCreated >= Time1 And FSO.GetFile(Directory & FileName).DateCreated <= Time2 Then
        'load file into Field1
        rsChild.AddNew
        rsChild.Fields("FileData").LoadFromFile FileName
        rsChild.Update
        rsParent.Update
    End If
    
Exit_AddImage:
    
    FileName = Dir()
    OpenFile = ""
    Loop
'''''''''''''''''''''---------------------------------------------
Set rsChild = Nothing
Set rsParent = Nothing
Exit Sub
Err_AddImage:
If Err = 3820 Then
MsgBox ("File already part of the multi-valued field!")
Resume Next
Else
MsgBox "Some Other Error occured!", Err.Number, Err.Description
Resume Exit_AddImage
End If
End Sub 

[ZachAtaiyan]

Update: I have been able to make a single image upload from the folder, but my timeframe logic is not working. Any ideas?

• The Camera app is called with Command27_Click(), Time1 is recorded with "Time1=Now"
• The "Import Photos" command is called with Command33_Click(), and:
  
  • Time2=Now
  • All files created between Time1 and Time2 should be imported as attachments into the record. (Again, I am aware of bloat, but I am not concerned by it in this case)
  • When the button is clicked, only the earliest file is imported and then I am given "error 3420 Object invalid or no longer set" for each remaining file.

Any ideas?

Private Sub Command27_Click()
'Image Capture Button - Utilizes Panasonic FZ-G1's Camera utility to capture images and store them to each record.
'Each photo is approx 149kb.
Dim Time1 As Date
'Open the Camera Utility
    'Call Shell("C:\Program Files (x86)\Panasonic\PCam\PCam.exe", vbNormalFocus)
    Call Shell("C:\Windows\System32\mspaint.exe", vbNormalFocus)
'Take initial timestamp
Time1 = Now
 
End Sub
Private Sub Command33_Click()
On Error GoTo Err_AddImage
Dim db As DAO.Database
Dim rsParent As DAO.Recordset2
Dim rsChild As DAO.Recordset2
Dim FileName As String
Dim Directory As String
Dim FSO As Object
Dim Time1 As Date
Dim Time2 As Date
'Take Final Timestamp
Time2 = Now

Set db = CurrentDb
Set rsParent = Me.Recordset
rsParent.Edit
Set rsChild = rsParent.Fields("Field1").Value
    'File Source Folder
    Directory = "C:\Users\zfataiyan\Desktop\TESTFOLDER"
        If Right(Directory, 1) <> "\" Then
            Directory = Directory & "\"
        End If
    
    'Search for all files in the directory with an .jpg* file type.
         FileName = Dir(Directory & "*.jpg*")
'Use Do loop to add files created after Time1 and Before Time2.
    Set FSO = CreateObject("Scripting.FileSystemObject")
'''''Loop Time''''''--------------------------------------------
''''''''''''''''''''
Do While FileName <> ""
    If FSO.GetFile(FileName).DateCreated >= Time1 And FSO.GetFile(FileName).DateCreated <= Time2 Then
        'load file into Field1
        rsChild.AddNew
        rsChild.Fields("FileData").LoadFromFile FileName
        rsChild.Update
        rsParent.Update
    End If
    
Exit_AddImage:
    
    FileName = Dir
    Loop
'''''''''''''''''''''---------------------------------------------
Set rsChild = Nothing
Set rsParent = Nothing
Exit Sub
Err_AddImage:
If Err = 3820 Then
MsgBox ("File already part of the multi-valued field!")
Resume Next
Else
MsgBox Err.Number & Err.Description
Resume Exit_AddImage
End If
End Sub 

[ItsMe]

When you are Debugging, the first thing you want to do is not have error handling. I commented it out. As I recommended prior, test for enumeration or at least iteration of the files in your directory. I commented out the creation of the Recordset. Another thing you want to do is not loop anything until after you get the first iteration completed successfully.

With the following, you can start to isolate where your first problem is.

'On Error GoTo Err_AddImage
Dim db As DAO.Database
Dim rsParent As DAO.Recordset2
Dim rsChild As DAO.Recordset2
Dim strFileName As String
Dim strDirectory As String
Dim FSO As Object
Dim dtTime1 As Date
Dim dtTime2 As Date
Set db = CurrentDb
'Set rsParent = Me.Recordset
'rsParent.Edit
'Set rsChild = rsParent.Fields("Field1").Value
'    'File Source Folder
'    strDirectory = "C:\Users\zfataiyan\Desktop\TESTFOLDER"
    strDirectory = "C:\test"
        If Right(strDirectory, 1) <> "\" Then
            strDirectory = strDirectory & "\"
        End If
dtTime1 = 1 - 1 - 1990
dtTime2 = Now
    
    'Search for all files in the directory with an .jpg* file type.
         strFileName = Dir(strDirectory, vbDirectory)
'Use Do loop to add files created after dtTime1 and Before dtTime2.
    Set FSO = CreateObject("Scripting.FileSystemObject")
'''''Loop Time''''''--------------------------------------------
''''''''''''''''''''
'Do While strFileName <> ""
    OpenFile = strDirectory & strFileName
    If FSO.GetFile(strDirectory & strFileName).DateCreated >= dtTime1 And FSO.GetFile(strDirectory & strFileName).DateCreated <= dtTime2 Then
    
    
    MsgBox "Found One"
'        'load file into Field1
'        rsChild.AddNew
'        rsChild.Fields("FileData").LoadFromFile strFileName
'        rsChild.Update
'        rsParent.Update
    End If
    
    
Exit_AddImage:
    
    strFileName = Dir()
    OpenFile = ""
    
'Loop

'''''''''''''''''''''---------------------------------------------
Set rsChild = Nothing
Set rsParent = Nothing
Exit Sub
Err_AddImage:
If Err = 3820 Then
MsgBox ("File already part of the multi-valued field!")
Resume Next
Else
MsgBox "Some Other Error occured!", Err.Number, Err.Description
Resume Exit_AddImage
End If

[ZachAtaiyan]

Thank you!

I am going through it right now. I may just be dumb, but I am experiencing issues with strFileName="." in the debugger, I dont know how to deal with that...any ideas?

[ItsMe]

Yup, that is issue number one, the way I see it.

Need to give it a value.

Perhaps you can get the file name after it is enumerated. You do not necessarily have to go after the technique in the code I previously posted. You just need a way to enumerate the files. You could use an index too, probably. I may have some time to look at it again later. Right now, the Do While strFileName <> "" thing seems a little too simplistic to me (to work).

[ZachAtaiyan]

Thank you for all the help, I finally figure it out. There was something wrong with the loop I was using. Here is my successful code:

Dim Time1 As Date
Dim Time2 As Date

Private Sub Command27_Click()
'Image Capture Button - Utilizes Panasonic FZ-G1's Camera utility to capture images and store them to each record.
'Each photo is approx 149kb.
'Open the Camera Utility
    'Call Shell("C:\Program Files (x86)\Panasonic\PCam\PCam.exe", vbNormalFocus)
    Call Shell("C:\Windows\System32\mspaint.exe", vbNormalFocus)
'Captures initial boundary timestamp
Time1 = Now

End Sub
Private Sub Command33_Click()
'Calls Subroutine that Attaches Images
Call LoopThroughFiles
End Sub
' SubRoutine
Sub LoopThroughFiles()
    Dim db As DAO.Database
    Dim rsParent As DAO.Recordset2
    Dim rsChild As DAO.Recordset2
    Dim StrFile As String
    Dim FileTime As Date
    'Captures end boundary timestamp
    Time2 = Now
  
    StrFile = Dir("C:\Users\zfataiyan\Desktop\TESTFOLDER\*.jpg*")
    Do While Len(StrFile) > 0
        FileTime = FileDateTime(StrFile)
        
        If FileTime >= Time1 And FileTime <= Time2 Then
            Set db = CurrentDb
            Set rsParent = Me.Recordset
            rsParent.Edit
            Set rsChild = rsParent.Fields("Field1").Value
            rsChild.AddNew
            rsChild.Fields("FileData").LoadFromFile StrFile
            rsChild.Update
            rsParent.Update
Exit_AddImage:
            Set rsChild = Nothing
            Set rsParent = Nothing
        End If
        
        StrFile = Dir
    Loop
End Sub
Private Sub Command34_Click()
End Sub

[ItsMe]

Glad you were able to make progress. A couple observations

I do not see any execution of creating a JPG in the following
'Call Shell("C:\Program Files (x86)\Panasonic\PCam\PCam.exe", vbNormalFocus)
Call Shell("C:\Windows\System32\mspaint.exe", vbNormalFocus)

Also, the time that the shell command executes and the following may not be the same time.
'Captures initial boundary timestamp
Time1 = Now

Another small observation is you are mixing your naming conventions. Here, you are using camelCase
Dim rsParent As DAO.Recordset2
Dim rsChild As DAO.Recordset2

Here you are using Pascal
Dim Time1 As Date
Dim Time2 As Date

I recommend stick to one convention. I will use both conventions within the same app. However, I do not switch back and forth for the same type of object, class, field, etc. For instance, I use camelCase most everywhere within Access, tables, forms, queries, variables, functions. The place I use Pascal is for field names within tables and queries. Use what works for you best. But, try to stay consistent. It will help to keep your eyes from catching fire when debugging something you did not allocate two days for and yet, you are on day three.