How do I find a file with two keywords and return a date modified in a specific column / row?-CodePudding

I'm trying to search a networked drive for files including two keywords. When found, I need them to return the last modified date of said file to the same row one of the keywords was pulled from. I've found something that is similar to what I need, but it doesn't search for specific keywords.

Sub GetFilesDetails()

' in column G= Date Last Modified

Dim objFSO As Scripting.FileSystemObject

Dim myFolder As Scripting.Folder

Dim myFile As Scripting.File

Dim R as Long

Set objFSO = CreateObject("Scripting.FileSystemObject")

Set myFolder = objFSO.GetFolder(“S:\”)

Application.ScreenUpdating = False

For Each myFile In myFolder.Files

       ThisWorkbook.Sheets("Sheet1").Cells(R, 7).Value = myFile.DateLastModified

       R = R   1

Next myFile

Application.ScreenUpdating = True

MsgBox "Updated"

End Sub

I need keyword 1 to be "Proof" and keyword 2 to be variable based on the column B value. So starting at row 4, Keyword "Proof" and (B4) are the search terms to find the most recent file, and return the last modified date of the file into (G4). From there continue through the rows performing the same task, but skip any row with a blank B cell.

Any help is greatly appreciated!

Edit: The keywords will be in the file name. ie "WO67547_Proof1" Proof is on all of the files that I will be looking for and the WO# is the variable. As long as the only last modified date pulled is the most recent, there shouldn't be more than one occurrence of the WO# and Proof keywords.

CodePudding user response：

Please, use the next code. It extract the matching file names matching each pair of the two keywords and choose the most recent date. The code should be very fast, using arrays. For processing and returning, too:

Sub GetFilesDetails()
  Dim sh As Worksheet, lastR As Long, arrKeys, arrDate, i As Long, fileName As String
  Dim folderPath As String, lastModifDate As Date, lastDate As Date
  Const key2 As String = "Proof"
  
  Set sh = ActiveSheet 'use here the necessary worksheet
  lastR = sh.Range("B" & sh.rows.count).End(xlUp).Row
  
  arrKeys = sh.Range("B4:B" & lastR).Value2 'place the range in an array for faster iteration
  arrDate = sh.Range("G4:G" & lastR).Value2
 
  folderPath = "C:/the necessary folder path" 'Use here your real Folder Path!!!
  For i = 1 To UBound(arrKeys)
        If arrKeys(i, 1) <> "" Then
            fileName = Dir(folderPath & "\" & "*" & arrKeys(i, 1) & "*" & key2 & "*.xlsx")
            lastDate = 0
            Do While fileName <> ""
                lastModifDate = CDate(Int(FileDateTime(folderPath & "\" & fileName)))
                If lastModifDate > lastDate Then lastDate = lastModifDate
                fileName = Dir
            Loop
            If lastModifDate <> 0 Then arrDate(i, 1) = lastModifDate: lastModifDate = 0
        End If
  Next i
  
  With sh.Range("G4").Resize(UBound(arrDate), 1)
        .Value2 = arrDate
        .NumberFormat = "dd-mmm-yy"
  End With
End Sub

Do not forget to update folderPath with your real folder where the files to be processed exist.