vba 我可以列出按修改日期排序的文件夹中的文件吗？
声明：本页面是StackOverFlow热门问题的中英对照翻译，遵循CC BY-SA 4.0协议，如果您需要使用它，必须同样遵循CC BY-SA许可，注明原文地址和作者信息，同时你必须将它归于原作者（不是我）：StackOverFlow
原文地址: http://stackoverflow.com/questions/22463411/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me):
StackOverFlow
提示：将鼠标放在中文语句上可以显示对应的英文。显示中英文
时间：2020-09-12 02:23:01 来源:igfitidea点击:
Can I list files from a folder sorted by date modified?
提问by Cris Reis
I found this code, but list file names sorted by name and I don't know how to adapt it:
我找到了这段代码，但列出了按名称排序的文件名，我不知道如何调整它：
Dim MyPathAs String
Dim MyNameAs String
With Dialogs(wdDialogCopyFile)
If .Display() <> -1 Then Exit Sub
MyPath = .Directory
End With
If Len(MyPath) = 0 Then Exit Sub
If Asc(MyPath) = 34 Then
MyPath = Mid$(MyPath, 2, Len(MyPath) - 2)
End If
MyName = Dir$(MyPath& "*.*")
Do While MyName<> ""
Selection.InsertAfterMyName&vbCr
MyName = Dir
Loop
Selection.CollapsewdCollapseEnd
End Sub
回答by Jean-Fran?ois Corbett
Here's a different way to do it. In Word VBA editor:
这是一种不同的方法。在 Word VBA 编辑器中：
Tools > References... > checkmark both of:
工具 > 参考文献... > 勾选以下两项：
- Microsoft Scripting Runtime
- Microsoft Excel Object Library
- Microsoft 脚本运行时
- Microsoft Excel 对象库
Then:
然后：
Dim iFil As Long
Dim FSO As FileSystemObject
Dim fil As File
Dim fld As Folder
Dim xlApp As Excel.Application
Dim sh As Excel.Worksheet
Dim rngTableTopLeft As Excel.Range
Set xlApp = New Excel.Application
Set sh = xlApp.Workbooks.Add.Sheets(1)
Set rngTableTopLeft = sh.Range("A1") ' or wherever; doesn't matter
'Put file names and date last modified in Excel sheet
Set FSO = New FileSystemObject
Set fld = FSO.GetFolder("C:\Users\jeacor\Documents")
For Each fil In fld.Files
iFil = iFil + 1
With rngTableTopLeft.Cells(iFil, 1)
.Value = fil.Name
.Offset(0, 1).Value = fil.DateLastModified
End With
Next fil
'Sort them by date last modified using Excel Sort function
With sh.Sort
.SortFields.Add Key:=rngTableTopLeft.Offset(0, 1).Resize(fld.Files.Count, 1), Order:=xlAscending
.SetRange rngTableTopLeft.Resize(fld.Files.Count, 2)
.Apply
End With
'Copy result to Word document
With rngTableTopLeft.Resize(fld.Files.Count, 2)
.EntireColumn.AutoFit
.Copy
End With
Selection.Paste
'Goodbye
xlApp.DisplayAlerts = False 'suppress the "exit without saving?" prompt
xlApp.Quit
