Need VBA to return modified date of file

Tango

DB/Application Dev Newbie
Local time
Today, 12:29
Joined
Jun 23, 2011
Messages
141
I have pieced together a script that works except for one problem. Where I call for ofsd it returns todays date instead of the date the file was last modified or created. Unfortunetly I have not been able to get anything else I have found on the net to work. Any help would be HUGELY appreciated.

Code:
Public Function FillDirToTable(colDirList As Collection _
, ByVal strFolder As String _
, strFileSpec As String _
, bIncludeSubfolders As Boolean)

'Allen Browne's code using Recursion, Collections, and the Dir() Function
'to find all Files in any Folder/Sub-Folder combination, that matches a
'specific File Specification (FileSpec).
'Build up a list of files, and then add add to this list, any additional folders
On Error Resume Next
Dim strTemp As String
Dim colFolders As New Collection
Dim vFolderName As Variant
Dim oFS As Object
Dim ofsd As String

On Error Resume Next
 

'Add the files to the folder.
strFolder = TrailingSlash(strFolder)        'produces ..Folder\
'strTemp returns the FileName matching the FileSpec in strFolder
strTemp = Dir(strFolder & strFileSpec)      'produces ..Folder\*.FileSpec
'This creates an instance of the MS Scripting Runtime FileSystemObject class
Set oFS = CreateObject("Scripting.FileSystemObject")
    
    
    
ofsd = oFS.GetFile(strTemp).Datelastmodified
ofsd = Format(Date, "-(mmm -dd- YYYY)-")

Do While strTemp <> vbNullString        'as long as FileNames are returned
  Forms!frmtest![lstFilesInDirectory].AddItem ofsd & "--------" & strTemp

    strTemp = Dir       'Recursively call the Dir() Function
Loop
If bIncludeSubfolders Then
  'Build collection of additional subfolders and search for any
  'Sub-Folders under strFolder
  strTemp = Dir(strFolder, vbDirectory)
    Do While strTemp <> vbNullString
      'If Sub-Folder, add to colFolders Collection
      If (strTemp <> ".") And (strTemp <> "..") Then
        If (GetAttr(strFolder & strTemp) And vbDirectory) <> 0& Then
          colFolders.Add strTemp
        End If
      End If
     strTemp = Dir          'Recursively call the Dir() Function
    Loop
    
    'Call function recursively for each subfolder.
    For Each vFolderName In colFolders
                                      '..Folder\Sub-Folder\----------------'
      Call FillDirToTable(colDirList, strFolder & TrailingSlash(vFolderName), strFileSpec, True)
    Next vFolderName
End If
End Function
 
Now just to make sure you know this - but some files, if you access them at all today, even if you don't change anything, will show the last modified date of today.
 
Now just to make sure you know this - but some files, if you access them at all today, even if you don't change anything, will show the last modified date of today.
These are all .log or .pdf files. Do you know if those types fall victim to this?
 
Thank you for your quick replies and help. I looked at your code and it makes sense but apparently I do not know enough to merge your code into mine. I merged it and it worked but I got the same result, todays date instead of the modified date. I checked the file folder and windows is showing the correct modified date. I think where I am getting hung up is putting a function inside another function and or pointing your code to the array made by my code without getting a file not found error.
 
Still trying to get your code to work inside mine but I apparently lack the know-how to combine the code segments. Any help would be greatly appreciated.
 
I use basically the same function (slightly different).

Here is an example of its use (in this case looping through a recordset and checking if the file was modified in the last 12 hours):

Code:
[I][FONT=Candara][SIZE=4]If FileLastModified(rst!FileCheck) > DateAdd("h", -12, Now()) Then[/SIZE][/FONT][/I]

And here's my function:

Code:
[I][FONT=Candara][SIZE=4]Function FileLastModified(strFullFileName As String)
    Dim fs As Object, f As Object
     
    Set fs = CreateObject("Scripting.FileSystemObject")
    Set f = fs.GetFile(strFullFileName)
     
    FileLastModified = f.DateLastModified
     
    Set fs = Nothing
    Set f = Nothing
     
End Function[/SIZE][/FONT][/I]
 
I got an "rst" not defined error so I assume that is the variable you called to identify your file. When I changed rst to strtemp I got a "qualifier must be collection" error on the ".filecheck"
 
Here is how I have it merged.
Code:
Option Compare Database
Option Explicit
Public gCount As Long
Public DFileDateTime As String
Function FileLastModified(strFullFileName As String)
    Dim fs As Object, f As Object
     
    Set fs = CreateObject("Scripting.FileSystemObject")
    Set f = fs.GetFile(strFullFileName)
     
    FileLastModified = f.DateLastModified
     
    Set fs = Nothing
    Set f = Nothing
     
End Function
 
 
 
 
Public Function FillDirToTable(colDirList As Collection _
, ByVal strFolder As String _
, strFileSpec As String _
, bIncludeSubfolders As Boolean)
On Error Resume Next
'Allen Browne's code using Recursion, Collections, and the Dir() Function
'to find all Files in any Folder/Sub-Folder combination, that matches a
'specific File Specification (FileSpec).
'Build up a list of files, and then add add to this list, any additional folders

Dim strTemp As String
Dim colFolders As New Collection
Dim vFolderName As Variant
 
DFileDateTime = Format(Date, "-(mmm-dd-YYYY)-")
    'USAGE:
    ' Immediate Window: ?GetLastModDate "C:\Temp\MyFile.xls"
    ' Returns: 6/22/2010 4:37:46 PM
    
  
'Add the files to the folder.
strFolder = TrailingSlash(strFolder)        'produces ..Folder\
'strTemp returns the FileName matching the FileSpec in strFolder
strTemp = Dir(strFolder & strFileSpec)      'produces ..Folder\*.FileSpec

If FileLastModified(strTemp!FileCheck) > DateAdd("h", -12, Now()) Then
Do While strTemp <> vbNullString        'as long as FileNames are returned
  Forms!frmtest![lstFilesInDirectory].AddItem DFileDateTime & "--------" & strTemp

    strTemp = Dir       'Recursively call the Dir() Function
Loop
End If
If bIncludeSubfolders Then
  'Build collection of additional subfolders and search for any
  'Sub-Folders under strFolder
  strTemp = Dir(strFolder, vbDirectory)
    Do While strTemp <> vbNullString
      'If Sub-Folder, add to colFolders Collection
      If (strTemp <> ".") And (strTemp <> "..") Then
        If (GetAttr(strFolder & strTemp) And vbDirectory) <> 0& Then
          colFolders.Add strTemp
        End If
      End If
     strTemp = Dir          'Recursively call the Dir() Function
    Loop
    
    'Call function recursively for each subfolder.
    For Each vFolderName In colFolders
                                      '..Folder\Sub-Folder\----------------'
      Call FillDirToTable(colDirList, strFolder & TrailingSlash(vFolderName), strFileSpec, True)
    Next vFolderName
End If
 
Exit_Handler:
  Exit Function
Err_Handler:
  Resume Exit_Handler
End Function
Public Function TrailingSlash(varIn As Variant) As String
  'Appends Trailing Slash to Folder Name if needed
  If Len(varIn) > 0& Then
    If Right(varIn, 1&) = "\" Then
      TrailingSlash = varIn
    Else
      TrailingSlash = varIn & "\"
    End If
  End If
End Function
 
As I said, in my case I was looping through a recordset (which I named rst) and checking the file name stored in the "FileCheck" field.

You could just as easily use it like this:

Code:
[I][FONT=Candara][SIZE=4]If FileLastModified("C:\test.txt") > Now()-1 Then
[/SIZE][/FONT][/I]

This would check the specified file for meing less than 24 hours old.
 
Ok, I am " " that close to getting it working. If I type in a file name like in your example it works but if I try to make it look at the strtemp variable to get the files name and location it just pops a "file not found" error. Any advice?

BTW, thanks SO much, you have both been a tremendous help.
 
Have you checked what strTemp actually contains?

Do a debug.print or msgbox to make sure it's got the value you expect.
 
That got it. Aparently STRtemp was returning the file name but the file location was stored in a different variable. I had to call both like (strFolder & strtemp).

Now it works I just have to tweak the interface.
 
Glad you got it sorted.

Msgbox / debug.print are the tools which I use most when my code isn't working as expected. It's worth keeping them in mind whenever you are using a variable for something and it doesn't work.
 

Users who are viewing this thread

Back
Top Bottom