Finding atribute LastAccessedDate of a file and make it a Excel range value

[blaksnm]

Hey guys
Almost Xmas and Santa will come! I hope ...
Have I been a good guy? Think so and can make a wish

I want to place the atribute (Date as value): "LastAccessDate" of a file called "!FileSessionStart.nwd" in Sheet1.Cell A2 in my workbook - without opening/accessing" this "C:/so-and-so/!FileSessionStart.nwd" - just want to read and use the last accessed date of it.

How will a macro go finding this atribute of this particular file and place this atribute as value as described?
The filepath of it is valued in celle A1

Anyone feel for giving me a little help here?
I would certainly appreciate it - cause I'm lost!

Best Regards
Snoopy

 

[btadams]

This should be better than a lump of coal:

'32 bit Windows declarations
Public Declare Function FindFirstFile Lib "kernel32" Alias "FindFirstFileA" _
    (ByVal lpFileName As String, lpFindFileData As WIN32_FIND_DATA) As Long
Public Declare Function FileTimeToSystemTime Lib "kernel32" _
    (lpFileTime As FILETIME, lpSystemTime As SYSTEMTIME) As Long
Declare Function FileTimeToLocalFileTime Lib "kernel32" _
    (lpFileTime As FILETIME, lpLocalFileTime As FILETIME) As Long

Public Type FILETIME
    dwLowDateTime As Long
    dwHighDateTime As Long
End Type

Public Type SYSTEMTIME
    wYear As Integer
    wMonth As Integer
    wDayOfWeek As Integer
    wDay As Integer
    wHour As Integer
    wMinute As Integer
    wSecond As Integer
    wMilliseconds As Long
End Type

Public Type WIN32_FIND_DATA
    dwFileAttributes As Long
    ftCreationTime As FILETIME
    ftLastAccessTime As FILETIME
    ftLastWriteTime As FILETIME
    nFileSizeHigh As Long
    nFileSizeLow As Long
    dwReserved0 As Long
    dwReserved1 As Long
    cFileName As String * 260
    cAlternate As String * 14
End Type

Private Function FileDate(FT As FILETIME) As String
'   convert the FILETIME to LOCALTIME, then to SYSTEMTIME type
    Dim ST As SYSTEMTIME
    Dim LT As FILETIME
    Dim t As Long
    Dim ds As Double
    Dim ts As Double
    t = FileTimeToLocalFileTime(FT, LT)
    t = FileTimeToSystemTime(LT, ST)
    If t Then
        ds = DateSerial(ST.wYear, ST.wMonth, ST.wDay)
        ts = TimeSerial(ST.wHour, ST.wMinute, ST.wSecond)
        ds = ds + ts
        If ds > 0 Then
            FileDate = Format$(ds, "mm/dd/yy hh:mm:ss AM/PM")
        Else
            FileDate = "(no date)"
        End If
    End If
End Function

Function ShowFileInfo(FullName As String)
'   This subroutine demonstrates the technique
    Dim hFile As Long
    Dim WFD As WIN32_FIND_DATA
    Dim FullName2 As String
    Dim Modified As String
    Dim LastWrite As String
     
'   FullName is the path and filename
'   Substitute any valid file and path
'    FullName = ActiveWorkbook.FullName
    hFile = FindFirstFile(FullName, WFD)
    
    If hFile > 0 Then
        Modified = FileDate(WFD.ftLastAccessTime)
        ShowFileInfo = Modified
'        MsgBox "File Created: " & Modified, vbInformation, FullName
    Else
        ShowFileInfo = vbNullString
        MsgBox "File not found.", vbCritical, FullName
    End If
End Function
 
Sub TestFileInfo()
    
    Range("D10") = ShowFileInfo("C:\Data\Temp\Book1.xls")
    
End Sub

Copy & paste the code above into a regular code module and then use the macro named TestFileInfo to test it out.

 

[MickG]

Hi, This is straight from Vb Help, I'm sure you can Modify to your needs.

<CODE>Sub ShowFileAccessInfo(filespec)
    Dim fs, f, s
    Set fs = CreateObject("Scripting.FileSystemObject")
    Set f = fs.GetFile(filespec)
    s = f.Name & " on Drive " & UCase(f.Drive) & vbCrLf
    s = s & "Created: " & f.DateCreated & vbCrLf
    s = s & "Last Accessed: " & f.DateLastAccessed & vbCrLf
    s = s & "Last Modified: " & f.DateLastModified  
    MsgBox s, 0, "File Access Info"
End Sub</CODE>
<CODE>

</CODE>
<CODE> Regards Mick

</CODE>

 

[blaksnm]

Thanks a lot both of you
Your help put me a long way forward!
One minor(?) problem remains though

This (Accessed)Date values appears as text-format and resist converting to number-format for further actions (sorting on dimension etc).
I can do some manually "hocus-pocus" ([double-click] in each cell and [esc]) to convert the value, but the macro will not follow my recorded instructions.

I have also tried to reformat Excel range, without success
I have tried to reformat VBA format-code as wellwithout success
I have tried to trim the values by formulas to eleminate hidden characters in the AccessedDateValue - surprisingly without success.
Have you guys an else idea of what to do?

 

[MickG]

Hi, If you Just want the "Date Value" try this mod:-

    s = s & "Created: " & DateValue(f.DateCreated) & vbCrLf
    s = s & "Last Accessed: " & DateValue(f.DateLastAccessed) & vbCrLf
    s = s & "Last Modified: " & DateValue(f.DateLastModified)

Regards Mick

 

[blaksnm]

Thanks Mick
I'll dive into this one
Best Regards
Snoopy

 

[blaksnm]

Sorry
I dont get this right
The right date shows as all right as cell.value, but formatted as text.
I cant manage to reformat this input if this date to act as number neither in Excel formatting nor VBA.

This was really a punch on the nose....
..still hoping for a happy ending.

Best Regards
Snoopy

(Sigh....may be a will relax myselft with chasing Red Barons?)

 

[MickG]

Hi, If this date is formatted as text , does it show as a Number or a Date,(Example please) and what do you want to do with this Number/Date after you have placed it in a cell.
Regards Mick

 

[blaksnm]

MickG
Thanks for your interest and respons

The format set in my macro goes like this:
arFiles(2, cnt) = Format(file.DateLastAccessed, "yyyy.mm.dd hh:mm")

The cell value is like this:
2009.12.01 12:21

When I manually double-click the celle (like editing) - but not change anything - the celle format automatic turns over to be numeric.
- magic, but it wouldnt be necessary as long as the VBA could do the walk.

I want to get the possibility to sett filter on my files to show all files in my list accessed between to points of time.
I dont think (=my experience) that this filter option will work when AccessedDate is performed as text.


Regards with best wishes for your Christmas season
Snoopy


Here is the complete macro sequence that lists the files and shows the LastAccessedDates (please overlook the Norwegian fraces):

Sub Folders()
Application.DisplayAlerts = False
On Error Resume Next
Sheets("Files").Delete
If Err.Number <> 0 Then
On Error GoTo 0
End If
Dim Folder As String
'Folder = InputBox("Enter ønsket RadNr.")
Folder = 6
Folder = Trim(Folder)
Dim i As Long

Set FSO = CreateObject("Scripting.FileSystemObject")

arFiles = Array()
cnt = 0
level = 1

ReDim arFiles(3, 0)
'**********************************
' henter fra folder
'**********************************
arFiles(0, 0) = Worksheets(1).Range("A" & Folder)
'arFiles(0, 0) = GetFolder()
If arFiles(0, 0) <> "" Then
'res = InputBox("Please enter an extension" & _
" to search for in the format'.nwd'")
res = ThisWorkbook.Worksheets("Board").Range("A8").Value
res = Trim(res)

arFiles(1, 0) = level
SelectFiles arFiles(0, 0)

Worksheets.Add.Name = "Files"
With ActiveSheet
.Cells(1, 1).Value = "Path"
.Cells(1, 2).Value = "FileName"
.Cells(1, 3).Value = "Accessed"
.Cells(1, 4).Value = "Size"
.Rows(1).Font.Bold = True
.Columns(4).NumberFormat = "#,##0 "" KB"""
cnt = 1
For i = LBound(arFiles, 2) To UBound(arFiles, 2)
.Cells(i + 2, 1).Value = arFiles(0, i)
.Cells(i + 2, 2).Value = arFiles(1, i)
.Cells(i + 2, 3).Value = arFiles(2, i)
.Cells(i + 2, 4).Value = arFiles(3, i) / 1024
' alttaki satýr badmin e ait.
ActiveSheet.Hyperlinks.Add _
Anchor:=.Cells(i + 2, 2), _
Address:=arFiles(0, i) & "\" & arFiles(1, i)
Next
.Columns("A:D").EntireColumn.AutoFit
End With
End If
Application.DisplayAlerts = True
End Sub

'-----------------------------------------------------------------------
Sub SelectFiles(ByVal sPath)
'-----------------------------------------------------------------------
Dim fldr As Object
Dim Folder As Object
Dim file As Object
Dim Files As Object

Set Folder = FSO.GetFolder(sPath)

Set Files = Folder.Files
For Each file In Files
If (file.Attributes And 2 Or _
file.Attributes And 4) Then
'
Else
If InStr(1, file.Name, res, vbTextCompare) > 0 Then
cnt = cnt + 1
ReDim Preserve arFiles(3, cnt)
arFiles(0, cnt) = Folder.path
arFiles(1, cnt) = file.Name
arFiles(2, cnt) = Format(file.DateLastAccessed, "yyyy.mm.dd hh:mm")
arFiles(3, cnt) = file.Size
End If
End If
Next file

level = level + 1
For Each fldr In Folder.Subfolders
SelectFiles fldr.path
Next

End Sub

 

[blaksnm]

See additionl informaton