API Date Folder was Created

[pcdaveh]

Does anyone know how to get the Date a Windows Folder was created, modified, and last accessed. Not a File but a folder.

 

[Aivars]

Hi!

Here's function for messaging of folder arguments:

msgbox FolderArgsMSG("C:\Program Files\Microsoft Office&quot

Function FolderArgsMSG(FolderSpec)
'This function return folder properties list
'for message box

On Error Resume Next
Dim fs, f, s
Set fs = CreateObject("Scripting.FileSystemObject&quot
Set f = fs.GetFolder(FolderSpec)

's = FileSpec & vbLf & vbLf
s = "Name: " & f.Name & vbLf
s = s & "Parent folder: " & f.parentfolder & vbLf & vbLf
s = s & vbTab & "File Type: " & f.Type & vbLf
s = s & vbTab & "File Created: " & f.DateCreated & vbLf
s = s & vbTab & "Last Modified: " & f.DateLastModified & vbLf
s = s & vbTab & "Last Accessed: " & f.DateLastAccessed & vbLf
s = s & vbTab & "File Size: " & f.Size & " bytes"

FolderArgsMSG = s
End Function

Aivars

 

[Aivars]

Hi again!

Here's improved version.
Try:
msgbox FolderArgsMSG("C:\Program Files\Microsoft Office&quot

msgbox FolderArgsMSG("C:\Program Files\Microsoft Office",False)

Function FolderArgsMSG(FolderSpec, _
Optional AdditionInform As Boolean = True)
'This function return folder properties list
'for message box
'If AdditionInform=True then
'information about all subfolders is show
On Error Resume Next
Dim fs, f, s
Dim lngAllSubFoldersCount As Long
Dim lngSubFolderFilesCount As Long
Dim strFolderName As String
Dim strSize As String

strFolderName = FolderSpec
Set fs = CreateObject("Scripting.FileSystemObject&quot
Set f = fs.GetFolder(FolderSpec)

's = FileSpec & vbLf & vbLf
s = "Name: " & f.Name & vbLf
s = s & "Parent folder: " & vbTab & vbTab & f.parentfolder & vbLf & vbLf
s = s & vbTab & "Folder Type: " & vbTab & vbTab & f.Type & vbLf
s = s & vbTab & "Folder Created: " & vbTab & vbTab & f.DateCreated & vbLf
s = s & vbTab & "Last Modified: " & vbTab & vbTab & f.DateLastModified & vbLf
s = s & vbTab & "Last Accessed: " & vbTab & vbTab & f.DateLastAccessed & vbLf
strSize = CStr(Format(f.Size, "Standard&quot) & vbLf
strSize = Left(strSize, InStr(1, strSize, ".", vbTextCompare) - 1)
s = s & vbTab & "Subfolders count: " & vbTab & f.SubFolders.Count & vbLf
s = s & vbTab & vbTab & "Files count: " & vbTab & f.Files.Count
If strSize = "" Then
'Permission denied
strSize = "Not available"
Else
strSize = strSize & " bytes"
End If
s = s & vbTab & "Folder Size: " & vbTab & vbTab & strSize
If AdditionInform Then
DoCmd.Hourglass True
s = s & vbLf
lngAllSubFoldersCount = SubFolderCount(strFolderName)
lngSubFolderFilesCount = SubFolderFilesCount(strFolderName)
s = s & vbTab & "All subfolders count: " & vbTab & lngAllSubFoldersCount & vbLf
s = s & vbTab & vbTab & "Files count: " & vbTab & lngSubFolderFilesCount
DoCmd.Hourglass False
End If

FolderArgsMSG = s
End Function
'-------------------------
Function SubFolderCount(FolderSpec As String, _
Optional lngSubDirCount As Long = 0) As Long
'This function return number of all subfolders which are contained
'on specific folder (FolderSpec)
On Error GoTo Err_SubFolderCount
Dim fs, f, f1, s, sf
Set fs = CreateObject("Scripting.FileSystemObject&quot
Set f = fs.GetFolder(FolderSpec)
lngSubDirCount = lngSubDirCount + f.SubFolders.Count
Set sf = f.SubFolders
If sf.Count > 0 Then
For Each s In sf
'Recursive call
lngSubDirCount = SubFolderCount(s.path, lngSubDirCount)
Next s
End If

Exit_SubFolderCount:
SubFolderCount = lngSubDirCount
Exit Function

Err_SubFolderCount:
If Err.Number <> 70 Then 'Permission denied
MsgBox &quot;Err No &quot; & Err.Number & vbLf & Err.Description, , &quot;Function SubFolderCount&quot;
End If
Resume Exit_SubFolderCount

End Function
'----------------------------
Function SubFolderFilesCount(FolderSpec As String, _
Optional lngFilesCount As Long = 0) As Long
'This function return number of all files
'in all subfolders which are contained
'on specific folder (FolderSpec)
On Error GoTo Err_SubFolderCount
Dim fs, f, f1, s, sf
Set fs = CreateObject(&quot;Scripting.FileSystemObject&quot
Set f = fs.GetFolder(FolderSpec)
lngFilesCount = lngFilesCount + f.Files.Count
Set sf = f.SubFolders
If sf.Count > 0 Then
For Each s In sf
'Recursive calls
lngFilesCount = SubFolderFilesCount(s.path, lngFilesCount)
Next s
End If

Exit_SubFolderCount:
SubFolderFilesCount = lngFilesCount
Exit Function

Err_SubFolderCount:
If Err.Number <> 70 Then 'Permission denied
MsgBox &quot;Err No &quot; & Err.Number & vbLf & Err.Description, , &quot;Function SubFolderFilesCount&quot;
End If
Resume Exit_SubFolderCount

End Function

Aivars