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

blaksnm

Active Member
Joined
Dec 15, 2009
Messages
487
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

Well-known Member
Joined
Jan 6, 2003
Messages
1,930
This should be better than a lump of coal:

Code:
'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

MrExcel MVP
Joined
Jan 9, 2008
Messages
14,841
Hi, This is straight from Vb Help, I'm sure you can Modify to your needs.
Rich (BB code):
<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

Active Member
Joined
Dec 15, 2009
Messages
487
Thanks a lot both of you :)
Your help put me a long way forward!
One minor(?) problem remains though :confused:

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?
 
Last edited:

MickG

MrExcel MVP
Joined
Jan 9, 2008
Messages
14,841
Hi, If you Just want the "Date Value" try this mod:-
Code:
    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

Active Member
Joined
Dec 15, 2009
Messages
487
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

MrExcel MVP
Joined
Jan 9, 2008
Messages
14,841
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

Active Member
Joined
Dec 15, 2009
Messages
487
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
 
Last edited:

Forum statistics

Threads
1,082,139
Messages
5,363,364
Members
400,731
Latest member
Jackserver

Some videos you may like

This Week's Hot Topics

  • populate from drop list with multiple tables
    Hi All, i have a drop list that displays data, what i want is when i select one of those from the list to populate text from different tables on...
  • Find list of words from sheet2 in sheet1 before a comma and extract text vba
    Hi Friends, Trying to find the solution on my task. But did not find suitable one to the need. Here is my query and sample file with details...
  • Dynamic Formula entry - VBA code sought
    Hello, really hope one of you experts can help with this - i've spent hours on this and getting no-where. .I have a set of data (more rows than...
  • Listbox Header
    Have a named range called "AccidentsHeader" Within my code I have: [CODE]Private Sub CommandButton1_Click() ListBox1.RowSource =...
  • Complex Heat Map using conditional formatting
    Good day excel world. I have a concern. Below link have a list of countries that carries each country unique data. [URL...
  • Conditional formatting
    Hi good morning, hope you can help me please, I have cells P4:P54 and if this cell is equal to 1 then i want row O to say "Fully Utilised" and to...
Top