Question

我有一个excel宏，它从我选择的文件夹中导入所有文件，然后将其放入工作表中，我想按照日期（因为文件是图片）而不是按文件名导入它们，以便照片按此顺序排列

002_1.jpg (time is 7:00am)
001_1.jpg (time is 7:01am)
003_1.jpg (time is 7:03am)

无论文件名如何，都可以查看文件的放置顺序。你有什么想法我可以修改我当前的宏来做到这一点吗？

Sub filegrabber()
Dim par, sfil As String
Dim r As Range
par = Application.InputBox("Enter The Directory Dont forget to add the \")
sfil = Dir(par & "*.*", vbDirectory)
Set r = ActiveCell
Do Until sfil = ""
If sfil = "." Or sfil = ".." Then GoTo skipit
r = sfil
ActiveCell.Hyperlinks.Add r, par & sfil
Set r = r.Offset(1)
skipit:
sfil = Dir$
Loop
End Sub

Answer 1

使用FileSystemObject检查文件的日期，然后再将其添加到工作表中。

Dim FileDirectory, FileName As String
Dim r As Range
Dim FindThisDate As Date

Sub filegrabber()
    FileDirectory = Application.InputBox("Enter The Directory Dont forget to add the \")
enterdate:
    FindThisDate = Application.InputBox("Enter The Date of files you want to load")
    If Not IsDate(FindThisDate) Then
        MsgBox "Please Enter A Valid Date", vbCritical, "Invalid Date"
        GoTo enterdate
     Else
        FindThisDate = CDate(FindThisDate)
    End If
    FileName = Dir(FileDirectory & "*.*", vbNormal) 'changed this from vbdirectory cuz you want files, not folders
    Set r = ActiveCell
    While FileName <> ""
        If filedate(FileDirectory & FileName) = FindThisDate Then
            r = FileName
            ActiveCell.Hyperlinks.Add r, FileDirectory & FileName
            Set r = r.Offset(1)
        End If
        FileName = Dir$
    Wend
End Sub

Function filedate(FileName) As Date
Dim fso, f
   Set fso = CreateObject("Scripting.FileSystemObject")
   Set f = fso.GetFile(FileName)
   filedate = DateValue(f.DateCreated)
   Set fso = Nothing
   Set f = Nothing
End Function

按日期导入文件名，而不是使用Excel宏导入文件名

1 个答案: