AnsweredAssumed Answered

Find Most resently modified document in a directory

Question asked by Joe Pickens on Feb 16, 2016
Latest reply on Feb 16, 2016 by Joe Pickens

I have this macro that finds solidworks files of a certain name in a folder and its subfolders.

 

what i want to add is for it to take the found files and if there are both assembly and part files i want it to ignore the part files and  if there is multiple of the file found i want it to take the on with the newest last date modified.

 

Right now i have it writhing the info to an excel sheet just so i can view what i am doing but this macro will have to be able to run without writing to excel.

 

'Force the explicit delcaration of variables

Option Explicit

 

 

Sub ListFiles()

 

 

    'Set a reference to Microsoft Scripting Runtime by using

    'Tools > References in the Visual Basic Editor (Alt+F11)

   

    'Declare the variables

    Dim objFSO As Scripting.FileSystemObject

    Dim objTopFolder As Scripting.folder

    Dim strTopFolderName As String

   

    'Insert the headers for Columns A through F

    Range("A1").Value = "File Name"

    Range("B1").Value = "File Size"

    Range("C1").Value = "File Type"

    Range("D1").Value = "Date Created"

    Range("E1").Value = "Date Last Accessed"

    Range("F1").Value = "Date Last Modified"

   

    'Assign the top folder to a variable

    strTopFolderName = "C:\Temp"

   

    'Create an instance of the FileSystemObject

    Set objFSO = CreateObject("Scripting.FileSystemObject")

   

    'Get the top folder

    Set objTopFolder = objFSO.GetFolder(strTopFolderName)

   

    'Call the RecursiveFolder routine

    Call RecursiveFolder(objTopFolder, True)

   

    'Change the width of the columns to achieve the best fit

    Columns.AutoFit

   

End Sub

 

 

Sub RecursiveFolder(objFolder As Scripting.folder, includeSubfolders As Boolean)

 

 

    'Declare the variables

    Dim objFile         As Scripting.file

    Dim objSubFolder    As Scripting.folder

    Dim NextRow         As Long

    Dim LatestDate      As Date

    Dim FileDate        As Date

    Dim FName           As String

    Dim FPath           As String

    Dim FSize           As Long

    Dim FType           As String

    Dim FDate           As String

   

    'Find the next available row

    NextRow = Cells(Rows.Count, "A").End(xlUp).row + 1

   

    'Loop through each file in the folder

    For Each objFile In objFolder.Files

        If Mid(objFile.Name, 1, Len(objFile.Name) - 7) = 168131000 Then

            If Right(objFile.Name, 6) = "sldprt" Or Right(objFile.Name, 6) = "sldasm" Or Right(objFile.Name, 6) = "SLDPRT" Or Right(objFile.Name, 6) = "SLDASM" Then

                          

                          

                FName = Mid(objFile.Name, 1, Len(objFile.Name) - 7)

                FSize = objFile.Size

                FType = objFile.Type

                FDate = objFile.DateLastModified

                FPath = objFile.Path

                          

                Cells(NextRow, "A").Value = FName

                Cells(NextRow, "B").Value = FSize

                Cells(NextRow, "C").Value = FType

                Cells(NextRow, "F").Value = FDate

                Cells(NextRow, "E").Value = FPath

 

 

                NextRow = NextRow + 1

           

            End If

      End If

       

    Next objFile

   

    'Loop through files in the subfolders

    If includeSubfolders Then

        For Each objSubFolder In objFolder.Subfolders

            Call RecursiveFolder(objSubFolder, True)

        Next objSubFolder

    End If

Outcomes