Vba 我可以列出按修改日期排序的文件夹中的文件吗?

Vba 我可以列出按修改日期排序的文件夹中的文件吗?,vba,ms-word,Vba,Ms Word,我找到了这段代码,但列出了按名称排序的文件名,我不知道如何调整它: 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 =

我找到了这段代码,但列出了按名称排序的文件名,我不知道如何调整它:

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
Dim MyPathAs字符串
Dim MyNameAs字符串
带对话框(wdDialogCopyFile)
如果.Display()-1,则退出Sub
MyPath=.Directory
以
如果Len(MyPath)=0,则退出Sub
如果Asc(MyPath)=34,则
MyPath=Mid$(MyPath,2,Len(MyPath)-2)
如果结束
MyName=Dir$(MyPath&“***”)
当我的名字为“”时执行此操作
选择。InsertAfterMyName和vbCr
MyName=Dir
环
Selection.CollapsewdCollapseEnd
端接头

这里有一种不同的方法。在Word VBA编辑器中:

工具>参考…>选中以下两项:

  • Microsoft脚本运行时
  • Microsoft Excel对象库
然后:


嗨,Jean,我需要Word中的这个代码,因为在实际情况中,我的代码还有其他功能!对,我没有注意到标签这个词。修改答案,将结果表从Excel复制到Word。
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