如何用双关键词搜索网络驱动器多唯一文件夹文件并返回修改日期至表格
网络驱动器多文件夹双关键词文件修改日期批量回写方案
此前使用的单文件夹检索VBA脚本仅支持对单个路径做匹配查询,以下是适配多文件夹遍历、双关键词匹配的调整后可直接运行代码:
Sub GetFilesDetails() Dim sh As Worksheet, lastR As Long, arrKeys, arrDate, i As Long, fileName As String Dim folderPaths As Variant, folderPath As Variant, lastModifDate As Date, lastDate As Date Const key2 As String = "Proof" ' 第二个固定匹配关键词,可按需修改 Const fileExt As String = "*.xlsx" ' 匹配的文件后缀,可按需修改 ' 配置所有需要检索的网络驱动器文件夹路径,支持UNC路径(如\\server\共享文件夹)和映射盘符路径 folderPaths = Array( _ "\\你的网络驱动器路径1\目标文件夹A", _ "\\你的网络驱动器路径2\目标文件夹B", _ "Z:\映射盘符下的目标文件夹C" _ ) Set sh = ActiveSheet ' 可替换为指定工作表,如Set sh = ThisWorkbook.Sheets("数据表名") lastR = sh.Range("B" & sh.Rows.Count).End(xlUp).Row arrKeys = sh.Range("B4:B" & lastR).Value2 ' B列为第一组动态匹配关键词 arrDate = sh.Range("G4:G" & lastR).Value2 ' G列为修改日期回写列 For i = 1 To UBound(arrKeys) If arrKeys(i, 1) <> "" Then lastDate = 0 ' 遍历所有配置的目标文件夹做匹配 For Each folderPath In folderPaths If Right(folderPath, 1) <> "\" Then folderPath = folderPath & "\" fileName = Dir(folderPath & "*" & arrKeys(i, 1) & "*" & key2 & "*" & fileExt) Do While fileName <> "" lastModifDate = CDate(Int(FileDateTime(folderPath & fileName))) If lastModifDate > lastDate Then lastDate = lastModifDate fileName = Dir Loop Next folderPath ' 写入匹配到的最新修改日期 If lastDate <> 0 Then arrDate(i, 1) = lastDate End If Next i ' 批量回写结果并设置统一日期格式 With sh.Range("G4").Resize(UBound(arrDate), 1) .Value2 = arrDate .NumberFormat = "dd-mmm-yy" End With MsgBox "检索完成,结果已写入表格", vbInformation End Sub
配置说明
- 请将
folderPaths数组中的示例路径替换为实际需要检索的所有网络文件夹路径,可根据需求增减数组内的路径条目 - 若需要调整固定匹配关键词、匹配文件后缀,直接修改代码头部对应常量的值即可
- 脚本默认从活动工作表B4单元格开始读取第一组匹配关键词,匹配到的最新文件修改日期会写入对应行的G列,若需要调整读写列,修改代码中对应的列标即可
- 匹配逻辑为文件名同时包含B列动态关键词、第二固定关键词,且后缀匹配指定格式,同规则下自动选取修改时间最新的文件日期作为结果
- 运行前请确认当前Windows账号对配置的所有网络文件夹有读取权限,否则会触发路径访问报错
内容的提问来源于stack exchange,提问作者Jakebnda
相关产品推荐
相关产品推荐

