VBscript to read for newest files in folder and subfolders

Could you define "newest" please?...

For example:
You want the 10 newest files (regardless of their age)?
You want files not older than 10 days?
You want files generated today or yesterday?
You want to sort the files based on creation/modified date and return only those matching the newest date?
...something else?...

Assuming you are basing it on date created, this code when run from Excel is dumping the info into an
Excel worksheet.

If you like the result, it is a short step to email the result automatically.  Let me know and I can add it.







' module starts here
Option Explicit

' Code based on procedures found at:
' http://www.exceltip.com/show_tip/Files,_Workbook,_and_Worksheets_in_VBA/
' List_files_in_a_folder_with_Microsoft_Scripting_Runtime_using_VBA_in_Microsoft_Excel/446.html

Private Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias _
    "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long
Private Declare Function SHBrowseForFolder Lib "shell32.dll" Alias _
    "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As Long

Public Type BROWSEINFO
  hOwner As Long
  pidlRoot As Long
  pszDisplayName As String
  lpszTitle As String
  ulFlags As Long
  lpfn As Long
  lParam As Long
  iImage As Long
End Type

Public dic As Object

Private Function GetDirectory(Optional Msg) As String
    Dim bInfo As BROWSEINFO
    Dim path As String
    Dim r As Long
    Dim x As Long
    Dim pos As Integer

' Root folder = Desktop
    bInfo.pidlRoot = 0&

' Title in the dialog
    If IsMissing(Msg) Then bInfo.lpszTitle = "Select a folder." Else bInfo.lpszTitle = Msg

' Type of directory to return
    bInfo.ulFlags = &H1

' Display the dialog
    x = SHBrowseForFolder(bInfo)

' Parse the result
    path = Space$(512)
    r = SHGetPathFromIDList(ByVal x, ByVal path)
    If r Then
        pos = InStr(path, Chr$(0))
        GetDirectory = Left(path, pos - 1)
    Else
        GetDirectory = ""
    End If

End Function

Sub DoListFilesInFolder()
   
    Dim CheckPath As String
    Dim Msg As Byte
    Dim Drilldown As Boolean
    Dim r As Long
    Dim Counter As Long
    Dim arr As Variant
   
    CheckPath = GetDirectory()
   
    If CheckPath = "" Then
        MsgBox "No folder was selected.  Procedure aborted.", vbExclamation, "StaffSmart Add-In"
        Exit Sub
    End If
   
    Msg = MsgBox("Do you want to list all files in descendant folders, too?", _
        vbInformation + vbYesNo, "Drill-Down")
    If Msg = vbYes Then Drilldown = True Else Drilldown = False
   
    Workbooks.Add ' create a new workbook for the file list
    ActiveWindow.Zoom = 75
    ' add headers
    With Range("A1")
        .Formula = "Folder contents: "
        .Font.Bold = True
        .Font.Size = 12
    End With
    Range("A3").Formula = "Folder:"
    Range("B3").Formula = "File Name:"
    Range("C3").Formula = "Date Created:"
    Range("A3:C3").Font.Bold = True
    ListFilesInFolder CheckPath, Drilldown
    ' list all files included subfolders

    arr = dic.Keys
    r = Range("A65536").End(xlUp).Row + 1
    For Counter = 0 To UBound(arr)
        ' display file properties
        Cells(Counter + r, 1).Formula = arr(Counter)
        Cells(Counter + r, 2).Formula = Split(dic.Item(arr(Counter)), "|")(1)
        Cells(Counter + r, 3).Formula = Split(dic.Item(arr(Counter)), "|")(0)
    Next
   
    Columns("A:H").AutoFit
   
    Range("a4").Select
    ActiveWindow.FreezePanes = True
    Range("a3").Sort Key1:=Range("A4"), Order1:=xlAscending, Key2:=Range("B4"), _
        Order2:=xlAscending, Header:=xlYes
   
    Range("a1") = Range("a1").Value & CheckPath & IIf(Drilldown, " (with descendants)", _
            " (without descendants)")
    Range("a3").Select
   
    ActiveWindow.LargeScroll Up:=100
   
    Set dic = Nothing
   
    MsgBox "Done", vbOKOnly, "StaffSmart Add-In"
   
End Sub

Private Sub ListFilesInFolder(SourceFolderName As String, IncludeSubfolders As Boolean)

' lists information about the files in SourceFolder
' example: ListFilesInFolder "C:\FolderName\", True

    Dim FSO As Object 'Scripting.FileSystemObject
    Dim SourceFolder As Object 'Scripting.Folder
    Dim SubFolder As Object 'Scripting.Folder
    Dim FileItem As Object 'Scripting.File
   
    If dic Is Nothing Then Set dic = CreateObject("Scripting.Dictionary")
   
    Set FSO = CreateObject("Scripting.FileSystemObject")
    Set SourceFolder = FSO.GetFolder(SourceFolderName)
   
    dic.Add SourceFolder.path, "1900-01-01 00:00:00|"
   
    For Each FileItem In SourceFolder.Files
        If dic.Item(SourceFolder.path) = "" Then
            dic.Item(SourceFolder.path) = Format(FileItem.DateLastModified, "yyyy-mm-dd hh:mm:ss") & "|" & FileItem.Name
        ElseIf Format(FileItem.DateLastModified, "yyyy-mm-dd hh:mm:ss") & "|" & FileItem.Name > dic.Item(SourceFolder.path) Then
            dic.Item(SourceFolder.path) = Format(FileItem.DateLastModified, "yyyy-mm-dd hh:mm:ss") & "|" & FileItem.Name
        End If
    Next FileItem

' If "descendant" folders also get their files listed, then sub calls itself recursively

    If IncludeSubfolders Then
        For Each SubFolder In SourceFolder.SubFolders
            ListFilesInFolder SubFolder.path, True
        Next SubFolder
    End If
       
    Set FileItem = Nothing
    Set SourceFolder = Nothing
    Set FSO = Nothing
   
End Sub

If this is pure VBScript (.vbs) then you can't use the API approach...

Idle_Mind,

It's not--it's VBA, which is why I said "if run from Excel"...

Double :)

Regards,

Patrick

Of course Patrick...I meant if the AUTHOR meant pure VBScript (.vbs)...   =)

jwpaco,

The snippet below shows how to use either the date created or date last modified.

Regards,

Patrick

' module starts here
Option Explicit 
' Code based on procedures found at:
' http://www.exceltip.com/show_tip/Files,_Workbook,_and_Worksheets_in_VBA/
' List_files_in_a_folder_with_Microsoft_Scripting_Runtime_using_VBA_in_Microsoft_Excel/446.html 
Private Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias _
    "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long
Private Declare Function SHBrowseForFolder Lib "shell32.dll" Alias _
    "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As Long 
Public Type BROWSEINFO
  hOwner As Long
  pidlRoot As Long
  pszDisplayName As String
  lpszTitle As String
  ulFlags As Long
  lpfn As Long
  lParam As Long
  iImage As Long
End Type 
Public dic As Object 
Private Function GetDirectory(Optional Msg) As String
    Dim bInfo As BROWSEINFO
    Dim path As String
    Dim r As Long
    Dim x As Long
    Dim pos As Integer 
' Root folder = Desktop
    bInfo.pidlRoot = 0& 
' Title in the dialog
    If IsMissing(Msg) Then bInfo.lpszTitle = "Select a folder." Else bInfo.lpszTitle = Msg 
' Type of directory to return
    bInfo.ulFlags = &H1 
' Display the dialog
    x = SHBrowseForFolder(bInfo) 
' Parse the result
    path = Space$(512)
    r = SHGetPathFromIDList(ByVal x, ByVal path)
    If r Then
        pos = InStr(path, Chr$(0))
        GetDirectory = Left(path, pos - 1)
    Else
        GetDirectory = ""
    End If 
End Function 
Sub DoListFilesInFolder()
    
    Dim CheckPath As String
    Dim Msg As Byte
    Dim Drilldown As Boolean
    Dim r As Long
    Dim Counter As Long
    Dim arr As Variant
    
    CheckPath = GetDirectory()
    
    If CheckPath = "" Then
        MsgBox "No folder was selected.  Procedure aborted.", vbExclamation, "StaffSmart Add-In"
        Exit Sub
    End If
    
    Msg = MsgBox("Do you want to list all files in descendant folders, too?", _
        vbInformation + vbYesNo, "Drill-Down")
    If Msg = vbYes Then Drilldown = True Else Drilldown = False
    
    Workbooks.Add ' create a new workbook for the file list
    ActiveWindow.Zoom = 75
    ' add headers
    With Range("A1")
        .Formula = "Folder contents: "
        .Font.Bold = True
        .Font.Size = 12
    End With
    Range("A3").Formula = "Folder:"
    Range("B3").Formula = "File Name:"
    Range("C3").Formula = "Date Created:"   'or "Date Last Modified" as desired
    Range("A3:C3").Font.Bold = True
    ListFilesInFolder CheckPath, Drilldown
    ' list all files included subfolders 
    arr = dic.Keys
    r = Range("A65536").End(xlUp).Row + 1
    For Counter = 0 To UBound(arr)
        ' display file properties
        Cells(Counter + r, 1).Formula = arr(Counter)
        Cells(Counter + r, 2).Formula = Split(dic.Item(arr(Counter)), "|")(1)
        Cells(Counter + r, 3).Formula = Split(dic.Item(arr(Counter)), "|")(0)
    Next
    
    Columns("A:H").AutoFit
    
    Range("a4").Select
    ActiveWindow.FreezePanes = True
    Range("a3").Sort Key1:=Range("A4"), Order1:=xlAscending, Key2:=Range("B4"), _
        Order2:=xlAscending, Header:=xlYes
    
    Range("a1") = Range("a1").Value & CheckPath & IIf(Drilldown, " (with descendants)", _
            " (without descendants)")
    Range("a3").Select
    
    ActiveWindow.LargeScroll Up:=100
    
    Set dic = Nothing
    
    MsgBox "Done", vbOKOnly, "StaffSmart Add-In"
    
End Sub 
Private Sub ListFilesInFolder(SourceFolderName As String, IncludeSubfolders As Boolean) 
' lists information about the files in SourceFolder
' example: ListFilesInFolder "C:\FolderName\", True 
    Dim FSO As Object 'Scripting.FileSystemObject
    Dim SourceFolder As Object 'Scripting.Folder
    Dim SubFolder As Object 'Scripting.Folder
    Dim FileItem As Object 'Scripting.File
    
    If dic Is Nothing Then Set dic = CreateObject("Scripting.Dictionary")
    
    Set FSO = CreateObject("Scripting.FileSystemObject")
    Set SourceFolder = FSO.GetFolder(SourceFolderName)
    
    dic.Add SourceFolder.path, "1900-01-01 00:00:00|<none>"
    
    For Each FileItem In SourceFolder.Files
        'for date last modified
        If dic.Item(SourceFolder.path) = "" Then
            dic.Item(SourceFolder.path) = Format(FileItem.DateLastModified, "yyyy-mm-dd hh:mm:ss") & "|" & FileItem.Name
        ElseIf Format(FileItem.DateLastModified, "yyyy-mm-dd hh:mm:ss") & "|" & FileItem.Name > dic.Item(SourceFolder.path) Then
            dic.Item(SourceFolder.path) = Format(FileItem.DateLastModified, "yyyy-mm-dd hh:mm:ss") & "|" & FileItem.Name
        End If
        'for date created
        'If dic.Item(SourceFolder.path) = "" Then
        '    dic.Item(SourceFolder.path) = Format(FileItem.DateCreated, "yyyy-mm-dd hh:mm:ss") & "|" & FileItem.Name
        'ElseIf Format(FileItem.DateCreated, "yyyy-mm-dd hh:mm:ss") & "|" & FileItem.Name > dic.Item(SourceFolder.path) Then
        '    dic.Item(SourceFolder.path) = Format(FileItem.DateCreated, "yyyy-mm-dd hh:mm:ss") & "|" & FileItem.Name
        'End If
    Next FileItem 
' If "descendant" folders also get their files listed, then sub calls itself recursively 
    If IncludeSubfolders Then
        For Each SubFolder In SourceFolder.SubFolders
            ListFilesInFolder SubFolder.path, True
        Next SubFolder
    End If
        
    Set FileItem = Nothing
    Set SourceFolder = Nothing
    Set FSO = Nothing
    
End Sub

Select allOpen in new window

I am just looking for a pure vbscript to recurse every folder on the drive or path and dump the newest file with path information to a text file.