如何找到具有两个关键字和 return 在特定列/行中修改日期的文件？

Question

我正在尝试在网络驱动器中搜索包含两个关键字的文件。找到后，我需要他们 return 将所述文件的最后修改日期添加到同一行，其中一个关键字是从中提取的。我找到了一些与我需要的类似的东西，但它没有搜索特定的关键字。

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

我需要关键字 1 为“Proof”，关键字 2 需要根据列 B 的值变化。所以从第 4 行开始，关键字“Proof”和 (B4) 是查找最新文件的搜索词，return 文件的最后修改日期进入 (G4)。从那里继续执行相同任务的行，但跳过任何包含空白 B 单元格的行。

非常感谢任何帮助！

编辑：关键字将在文件名中。即“WO67547_Proof1” 证明在我要查找的所有文件上，WO# 是变量。只要提取的唯一最后修改日期是最近的，WO# 和 Proof 关键字的出现次数不应超过一次。

Answer 1

请使用下一个代码。它提取匹配每对两个关键字的匹配文件名，并选择最近的日期。代码应该非常快，使用数组。处理和返回也一样：

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

不要忘记更新 folderPath 为要处理的文件所在的真实文件夹。

如何找到具有两个关键字和 return 在特定列/行中修改日期的文件？

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

excel

vba