由于提取文件跟扫描文件分开操作,因此,要注意:文件不要重名,不然扫描时路径会被覆盖。
附件就不上传了。你自己在原先的附件上改改好了。
Sub ScanFile()
'引用Microsoft Scripting Runtime库
Dim fso As New FileSystemObject
Dim fl As File
Dim fd As Folder
Dim i As Long
Dim s As Long
Dim sPath As String, sExt As String
s = Sheets(1).Range("B7").End(xlDown).Row
sPath = Sheets(1).Range("B2")
sExt = Sheets(1).Range("D2")
For i = 7 To s
'子文件夹
For Each fd In fso.GetFolder(sPath).SubFolders
For Each fl In fd.Files
If fl.Name = Sheets(1).Range("B" & i) & sExt Then
Sheets(1).Range("D" & i) = fl.DateLastModified
Sheets(1).Range("A" & i) = fl.Path
End If
Next
Next
'根目录文件
If Len(Dir(sPath & Sheets(1).Range("B" & i) & sExt)) > 0 Then
Sheets(1).Range("A" & i) = sPath & Sheets(1).Range("B" & i) & sExt
Sheets(1).Range("D" & i) = fso.GetFile(sPath & Sheets(1).Range("B" & i) & sExt).DateLastModified
End If
If Len(Sheets(1).Range("A" & i)) > 0 Then
Sheets(1).Range("C" & i) = "有"
Else
Sheets(1).Range("C" & i) = "无"
End If