1 Reply Latest reply on Feb 16, 2016 12:22 PM by Joe Pickens

    Find Most resently modified document in a directory

    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

        • Re: Find Most resently modified document in a directory
          Joe Pickens

          I figured it out

           

          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

          Dim NextRow         As Long

           

           

          '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)

             

             

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

             

                          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

             

             

             

             

             

             

             

              '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

           

           

             

              '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

                          LatestDate = objFile.DateLastModified

                          If LatestDate > FileDate Then

                          FileDate = LatestDate

                                    

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

                          FSize = objFile.Size

                          FType = objFile.Type

                          FDate = objFile.DateLastModified

                          FPath = objFile.Path

                                    

                          End If

                      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

             

                 

                 

                 

             

             

             

          End Sub