求助：提取各文件夹里的文档名称及修改日期

limonet

关键字：pscustomobject

limonet

Sub limonet()
    CreateObject("wscript.shell").Run "powershell push-location " & ThisWorkbook.Path _
    & ";Dir -Dir | Where {$_ -Match '[0-9].*'} | %{Dir ($_.FullName+'\*') -Include ('*.xlsx','*.pdf','*.ppt?','*.doc')}|" _
    & " %{[PSCustomObject]@{日期=('{0:D}' –F $_.LastWriteTime);分类=($_.Directory -Replace '.*\\' , '');" _
    & "文件名称或摘要=$_.BaseName} }  | Export-Csv limonet.csv -NoTypeInformation -Encoding default", 0
End Sub

guochangjj

limonet 发表于 2024-8-17 22:29
关键字：pscustomobject

不好意思，我水平有限，真不会用！但还是很感谢您的帮忙！

guochangjj

ykcbf1100 发表于 2024-8-16 19:18
加个排序就行了。

再请大侠帮忙：能否把表里的所有文件名称自动建立超链接到源文件呢？……这样就更完美，更方便使用了！谢谢您！

limonet

点按钮就可以运行。除非系统版本很低。

guochangjj

limonet 发表于 2024-8-18 15:33
点按钮就可以运行。除非系统版本很低。

哦，我用的是WPS，可能不太适用吧。还是感谢您！……系统是win7

limonet

guochangjj 发表于 2024-8-18 17:11
哦，我用的是WPS，可能不太适用吧。还是感谢您！……系统是win7

也许吧，那就用其他老师，他们写的更好。

ykcbf1100

guochangjj 发表于 2024-8-18 15:30
再请大侠帮忙：能否把表里的所有文件名称自动建立超链接到源文件呢？……这样就更完美，更方便使用了！谢 ...

加上超链接。。。

ykcbf1100

加上超链接。。。

1. Sub ykcbf()   '//2024.8.18
   
2.     Set fso = CreateObject("Scripting.FileSystemObject")
   
3.     Set sh = ThisWorkbook.Sheets("Sheet1")
   
4.     p = ThisWorkbook.Path & ""
   
5.     st = "PDF|DOC|DOCX|XLS|XLSX|PPT"
   
6.     ReDim brr(1 To 1000, 1 To 4)
   
7.     For Each fd In fso.GetFolder(p).SubFolders
   
8.         If Val(fd.Name) <= 20 Then
   
9.             For Each f In fso.GetFolder(fd).Files
   
10.                 fx = fso.GetExtensionName(f)
    
11.                 If InStr(st, UCase(fx)) Then
    
12.                     m = m + 1
    
13.                     brr(m, 1) = CDate(fso.getfile(f).DateLastModified)
    
14.                     brr(m, 2) = fd.Name
    
15.                     brr(m, 3) = fso.GetBaseName(f)
    
16.                     brr(m, 4) = f
    
17.                 End If
    
18.             Next
    
19.         End If
    
20.     Next
    
21.     With sh
    
22.         .UsedRange.Offset(2).ClearContents
    
23.         .[a3].Resize(m, 4) = brr
    
24.         Set Rng = .[a3].Resize(m, 4)
    
25.         Rng.Sort Rng.Columns(1), 1
    
26.         For i = 3 To m + 2
    
27.             s = .Cells(i, 3)
    
28.             fn = .Cells(i, 4)
    
29.             .Hyperlinks.Add Anchor:=.Cells(i, 3), Address:=fn
    
30.         Next
    
31.     End With
    
32.     MsgBox "OK！"
    
33. End Sub
    

复制代码

jpj123

ykcbf1100 发表于 2024-8-16 19:18
加个排序就行了。

值得学习，感谢老师！